Excel - Autoshape get it's name from cell (val

Question

I will try to explain this

I have VBA that based on value selected in sheet called TEXT you can select shape (like Circle, triangle, square) and shape number (1.2.3) and when you double click it immediately goes to next sheet called shapes and find that shape based on values you selected

Example: sheet TEXT in Cell K13 in drop-box select circle in cell L13 in drop-box select number 1. then double click in J13 and based on K13 and L13 it goes to sheet SHAPES and select shape that has name Circle1

This works fine because each shapes name (like circle1, circle2, triangle1, traingle2, square1, square2) match all combination that you can select from shape list ..

Problem: If I for some reason want to change names in drop-box from circle, triangle, quare to let say home, apartment, shop... then VBA can't find that names and I have to change names for all shapes to match new names....

Solution: What I need is that all shapes automatically change it's name so if Circle is changed to home etc.. all circle will change to home...

actually each shape looking for it's name from specific cells... example: circle1 uses it's name from B9+C9, circle2 B9+C10, triangle1 B10+C9, triangle2 B10+C10, square1 B11+C9, square2 B11+C10.. so if circle in B9 is changed to home all circle shape names will change to home, like home1, home2.

rows -column B shape - Column C number

row9 - Circle - 1

row10 - Triangle - 2

row11 - Square - 3

VBA
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim test As String
If Not Intersect(Target, Range("J13:J16")) Is Nothing Then
    test = Target.Offset(, 1).Value & Target.Offset(, 2).Value
    Worksheets("Shapes").Shapes(CStr(test)).Select
    Worksheets("Shapes").Activate
End If

End Sub

Thank you

Answer 1

You could run code like this. My code (xl2010) assumes that you inserted these shape tyoes

• Circle from the autoshape "Oval"
• Square from the autoshape "Rectangle"
• Triangle from the autoshape "Isosceles Triangle"

The code looks at a master range in A8:C11 that I expanded by 1 column form your example to provide a 1) Shape type 2) Shape number 3) Numbering system (see pic below)

The code when run looks at each shape on the sheet, tests if it is a circle, square or rectangle, looks up the name in the second column of the table, then applies the number of the position in the third column (note that you may need to add more numbers and extend this range).

So the code below names up to three circles as home1 home2 home3

up to three squares as square1 square2 square3

etc

You could either run this code when you wanted to manually, or run it automatically with events each time a cell in the name ranging table changes, or when you activtated this sheets etc

Sub ReName()
    Dim shp As Shape
    Dim rng1 As Range
    Dim lngCirc As Long
    Dim lngSq As Long
    Dim lngTri As Long
    Set rng1 = Sheets(1).Range("A8:C18")
    For Each shp In ActiveSheet.Shapes
        Select Case shp.AutoShapeType
        Case msoShapeOval
            lngCirc = lngCirc + 1
            shp.Name = rng1.Cells(2, 2) & rng1.Cells(1, 3).Offset(lngCirc)
        Case msoShapeIsoscelesTriangle
            lngTri = lngTri + 1
            shp.Name = rng1.Cells(3, 2) & rng1.Cells(1, 3).Offset(lngTri)
        Case msoShapeRectangle
            lngSq = lngSq + 1
            shp.Name = rng1.Cells(4, 2) & rng1.Cells(1, 3).Offset(lngSq)
        Case Else
            Debug.Print "Check shape: " & shp.Name & " of " & shap.AutoShapeType
        End Select
    Next
End Sub