Square shapes change names when value from list change

[lenis]

I have file with VBA that change shape names based on 2 lists data...
1 list contain data like home, building, elevator etc... second has digits 1.2.3 etc. so every shape match it's name in namebox (not text in shape) to those two lists like home1, home2, builidng1, building2 etc...
check image Click for image

Script works fine if you only changing first list home, building, elevator but what I need VBA change to shape names when I change second column and use text instead of numbers 1,2,3, so it will be like

list1 list2
home left

so I change left to right and shape update it's name to homeright

check file
Click for file

ShapesV2.xls

VBA

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim shp As Shape
    Dim nw As Variant
    Dim old As Variant

    ' in case there is an error...
    On Error GoTo CleanUp
    Set rng = Intersect(Target, [Shape])
    If Not rng Is Nothing Then
        ' Save new name
        nw = Target
        ' Prevent events firing while we change sheet values
        Application.EnableEvents = False
        ' Get previous name
        Application.Undo
        old = Target
        ' Restore new name
        Target = nw
        ' Rename selected Shapes
        For Each shp In Me.Shapes
            If shp.Name Like old & "#*" Then
                shp.Name = nw & Mid(shp.Name, Len(old) + 1)
            End If
        Next
    End If
CleanUp:
    ' Re-enable events
    Application.EnableEvents = True
End Sub

[Ken Puls]

Hi there, and welcome to the forum.

Just as a heads up, if you click "Go Advanced", you can upload your workbook and images to my site, so you don't have to link elsewhere.

With regards to your issue... the following code will do what you're asking but you do need to:

• Expand your list a bit. Each "Home" record will need it's own line.
• Make your entry match the shape name before you start changing it. i.e. if you create a new shape and it's called "Square1", you need to put "Square" in the shape column, then "1" in the Number column, then change what you're after.

Here's the code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim shp As Shape
    Dim nw As Variant
    Dim old As Variant
    ' in case there is an error...
    On Error GoTo CleanUp
    Set rng = Intersect(Target.EntireRow, [Shape:Number])
    Debug.Print rng.Address
    
    If Not rng Is Nothing Then
        ' Save new name
        nw = rng.Cells(1, 1) & "|" & rng.Cells(1, 2)
        ' Prevent events firing while we change sheet values
        Application.EnableEvents = False
        ' Get previous name
        Application.Undo
        old = rng.Cells(1, 1) & rng.Cells(1, 2)
        ' Restore new name
        rng.Value = Split(nw, "|")
        ' Rename selected Shapes
        For Each shp In Me.Shapes
                Debug.Print shp.Name
            If shp.Name = old Then
                shp.Name = Replace(nw, "|", "") 'nw & Mid(shp.Name, Len(old) + 1)
                Exit For
            End If
        Next
    End If
CleanUp:
    ' Re-enable events
    Application.EnableEvents = True
End Sub

PS.. Congratulations, you're post number 500 in the forum.

[lenis]

Hello Ken

thank you for your reply

500 and I wish more


I tried this VBA and it changes shape name for first shape...
problem is that in those 2 lists I need combination and unique values...

Ok let me explain on this way
lets look on this workbook like map of houses and every house has it's furniture (so I update data like that in file)...
so sheet SHAPES has houses and furniture in 2 lists and combination of those 2 every shape is named on way house1table, house1chair... house2table, house2chair etc... every house same furniture...
so what I need if I change home1 to house1 that all shapes that has home1 (like home1table,home1chair etc..) change to house1 (house1table, house1chair etc..), and also If I change word table to desk that all shapes contain word table (home1table, home2table, home3table) changes it's name to desk like (home1desk, home2desk, home3desk)...
I need those combinations as on
sheet TEXT there are cells in this file K6 is listbox that takes it's data from houses list sheet SHAPES and Cell L6 is llistbox that takes it's data from furniture list sheet SHAPES so if let say in K6 you select home1 and in L6 table there is VBA that created link and if you doubleclick on J6 it checks K6+L6 and goes to corespodent shape in this case home1table.....

check file

check images for explanation





Thank you

[Ken Puls]

Hi there,

I'll try and look at this one later tonight if no one gets to it first.