Multiple shapes visible based of cell value

[SCSabresfan]

I am trying to change the visibility of several shapes based off of the value in a row of cells.
Here are the details:

• Shape Names are sequential
  • LineATop, LineBTop, LineCTop, etc
  • LineABottom, LineBBottom, LineCBottom, etc
• Values to base the shape visibility is in g46, j46, m46, etc

I currently have a formula in cells g46, j46, m46, etc that returns either Top, Middle or Bottom based off another cell value. If g46 contains "Top" I want it to leave LineATop visible, but make LineAMiddle and LineABottom invisible. If g46 contains "Middle" I want it to leave LineAMiddle visible, but make LineATop and LineABottom invisible. If g46 contains "-", I want LineATop, LineAMiddle and LineABottom to all be invisible. I have tried a couple of other examples I found, but none of them allowed for multiple shapes to change visibility off one value. Can anyone help this VBA newbie???

 

[kevin9999]

Here's a quick demo of one way to change multiple shapes on a sheet based on a single value. Here I've used cell G46 for the value, and this code looks at LineA.... shapes only. Please try it on a copy of your workbook.

Option Explicit
Sub Test()
    Dim s As String, L As Object
    s = Worksheets("Sheet1").Range("G46")       '<-- *** Change to actual sheet name ***

    For Each L In ActiveSheet.Shapes
        If L.Name Like "LineA" & "*" Then
            If Not L.Name Like "*" & s & "*" Then
                L.Visible = False
            Else
                L.Visible = True
            End If
        End If
    Next L

End Sub

 

[SCSabresfan]

I ended up overhauling my code after reviewing with some coworkers. Here is what I ended up with. It seems to slow excel down to a crawl. Is there a way to simplify the code? The lines and dimensions go from A to J and the objects are named similar. I only show A to C below for simplicity.

Private Sub Worksheet_Calculate()

'Visible Lines for flaw A
If Range("G42").Value = "-" Then
Shapes.Range(Array("LineABottom")).Line.Visible = msoFalse
Shapes.Range(Array("DimATop")).Line.Visible = msoFalse
Else
Shapes.Range(Array("LineABottom")).Line.Visible = msoTrue
Shapes.Range(Array("DimATop")).Line.Visible = msoTrue
End If

If Range("G54").Value = 1 Then
Shapes.Range(Array("DimABottom")).Line.EndArrowheadStyle = msoArrowheadNone
Shapes.Range(Array("DimABottom")).Line.BeginArrowheadStyle = msoArrowheadNone
Else
If Range("G54").Value = 2 Then
Shapes.Range(Array("DimABottom")).Line.EndArrowheadStyle = msoArrowheadTriangle
Shapes.Range(Array("DimABottom")).Line.BeginArrowheadStyle = msoArrowheadNone
Else
If Range("G54").Value = 3 Then
Shapes.Range(Array("DimABottom")).Line.EndArrowheadStyle = msoArrowheadNone
Shapes.Range(Array("DimABottom")).Line.BeginArrowheadStyle = msoArrowheadTriangle
Else
If Range("G54").Value = 4 Then
Shapes.Range(Array("DimABottom")).Line.EndArrowheadStyle = msoArrowheadTriangle
Shapes.Range(Array("DimABottom")).Line.BeginArrowheadStyle = msoArrowheadTriangle
End If
End If
End If
End If

'Visible Lines for flaw B
If Range("J42").Value = "-" Then
Shapes.Range(Array("LineBBottom")).Line.Visible = msoFalse
Shapes.Range(Array("DimBTop")).Line.Visible = msoFalse
Else
Shapes.Range(Array("LineBBottom")).Line.Visible = msoTrue
Shapes.Range(Array("DimBTop")).Line.Visible = msoTrue
End If

If Range("J53").Value = 0 Then
Shapes.Range(Array("DimBBottom")).Line.Visible = msoFalse
Else
Shapes.Range(Array("DimBBottom")).Line.Visible = msoTrue
End If

If Range("J54").Value = 1 Then
Shapes.Range(Array("DimBBottom")).Line.EndArrowheadStyle = msoArrowheadNone
Shapes.Range(Array("DimBBottom")).Line.BeginArrowheadStyle = msoArrowheadNone
Else
If Range("J54").Value = 2 Then
Shapes.Range(Array("DimBBottom")).Line.EndArrowheadStyle = msoArrowheadTriangle
Shapes.Range(Array("DimBBottom")).Line.BeginArrowheadStyle = msoArrowheadNone
Else
If Range("J54").Value = 3 Then
Shapes.Range(Array("DimBBottom")).Line.EndArrowheadStyle = msoArrowheadNone
Shapes.Range(Array("DimBBottom")).Line.BeginArrowheadStyle = msoArrowheadTriangle
Else
If Range("J54").Value = 4 Then
Shapes.Range(Array("DimBBottom")).Line.EndArrowheadStyle = msoArrowheadTriangle
Shapes.Range(Array("DimBBottom")).Line.BeginArrowheadStyle = msoArrowheadTriangle
End If
End If
End If
End If

'Visible Lines for flaw C
If Range("M42").Value = "-" Then
Shapes.Range(Array("LineCBottom")).Line.Visible = msoFalse
Shapes.Range(Array("DimCTop")).Line.Visible = msoFalse
Else
Shapes.Range(Array("LineCBottom")).Line.Visible = msoTrue
Shapes.Range(Array("DimCTop")).Line.Visible = msoTrue
End If

If Range("M53").Value = 0 Then
Shapes.Range(Array("DimCBottom")).Line.Visible = msoFalse
Else
Shapes.Range(Array("DimCBottom")).Line.Visible = msoTrue
End If

If Range("M54").Value = 1 Then
Shapes.Range(Array("DimCBottom")).Line.EndArrowheadStyle = msoArrowheadNone
Shapes.Range(Array("DimCBottom")).Line.BeginArrowheadStyle = msoArrowheadNone
Else
If Range("M54").Value = 2 Then
Shapes.Range(Array("DimCBottom")).Line.EndArrowheadStyle = msoArrowheadTriangle
Shapes.Range(Array("DimCBottom")).Line.BeginArrowheadStyle = msoArrowheadNone
Else
If Range("M54").Value = 3 Then
Shapes.Range(Array("DimCBottom")).Line.EndArrowheadStyle = msoArrowheadNone
Shapes.Range(Array("DimCBottom")).Line.BeginArrowheadStyle = msoArrowheadTriangle
Else
If Range("M54").Value = 4 Then
Shapes.Range(Array("DimCBottom")).Line.EndArrowheadStyle = msoArrowheadTriangle
Shapes.Range(Array("DimCBottom")).Line.BeginArrowheadStyle = msoArrowheadTriangle
End If
End If
End If
End If