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
View attachment ShapesV2.xls
VBA
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
View attachment ShapesV2.xls
VBA
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, [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