Modify properties of multiple shapes based on cell contents

glad_ir

Board Regular
Joined
Nov 22, 2020
Messages
143
Office Version
  1. 2010
Platform
  1. Windows
Hi,

I wonder if you can help please. I have the macro below to hide shapes dependent on related cell contents. It works fine but I'm hoping somebody can share a more efficient way to do this as I'll need to apply to over 200 shapes to complete the workbook! As you can tell I am a beginner!

Any help would be much appreciated.

thank you.
Iain


VBA Code:
    If Range("Am34") = 1 Then
    ActiveSheet.Shapes.Range(Array("Right Arrow 195")).Select
    Selection.ShapeRange.ThreeD.Visible = msoFalse
    Selection.ShapeRange.Fill.Visible = msoFalse
    End If
    
    If Range("Am34") = 2 Then
    ActiveSheet.Shapes.Range(Array("Right Arrow 195")).Select
    Selection.ShapeRange.ThreeD.Visible = msoTrue
    Selection.ShapeRange.Fill.Visible = msoTrue
    End If
    
    If Range("bm34") = 1 Then
    ActiveSheet.Shapes.Range(Array("Right Arrow 196")).Select
    Selection.ShapeRange.ThreeD.Visible = msoFalse
    Selection.ShapeRange.Fill.Visible = msoFalse
    End If
    
    If Range("bm34") = 2 Then
    ActiveSheet.Shapes.Range(Array("Right Arrow 196")).Select
    Selection.ShapeRange.ThreeD.Visible = msoTrue
    Selection.ShapeRange.Fill.Visible = msoTrue
    End If
    
    If Range("cm34") = 1 Then
    ActiveSheet.Shapes.Range(Array("Right Arrow 162")).Select
    Selection.ShapeRange.ThreeD.Visible = msoFalse
    Selection.ShapeRange.Fill.Visible = msoFalse
    End If
    
    If Range("cm34") = 2 Then
    ActiveSheet.Shapes.Range(Array("Right Arrow 162")).Select
    Selection.ShapeRange.ThreeD.Visible = msoTrue
    Selection.ShapeRange.Fill.Visible = msoTrue
    End If

and so on to DM34, EM34 up to HM34, then I need to repeat on lower rows.....
 
Last edited by a moderator:

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Try the following...

VBA Code:
    Dim arr() As Variant
    arr() = Array("am34", "195", "bm34", "196", "cm34", "162") 'add your other ranges and corresponding numbers
   
    Dim i As Long
    For i = LBound(arr) To UBound(arr) Step 2
        If Range(arr(i)).Value = 1 Then
            With ActiveSheet.Shapes("Right Arrow " & arr(i + 1))
                .ThreeD.Visible = msoFalse
                .Fill.Visible = msoFalse
            End With
        ElseIf Range(arr(i)).Value = 2 Then
            With ActiveSheet.Shapes("Right Arrow " & arr(i + 1))
                .ThreeD.Visible = msoTrue
                .Fill.Visible = msoTrue
            End With
        End If
    Next i

Actually, it can also be written this way...

VBA Code:
    Dim arr() As Variant
    arr() = Array("am34", "195", "bm34", "196", "cm34", "162")
   
    Dim i As Long
    Dim flag As Long
    For i = LBound(arr) To UBound(arr) Step 2
        If Range(arr(i)).Value = 1 Then
            flag = msoFalse
        ElseIf Range(arr(i)).Value = 2 Then
            flag = msoTrue
        End If
        With ActiveSheet.Shapes("Right Arrow " & arr(i + 1))
            .ThreeD.Visible = flag
            .Fill.Visible = flag
        End With
    Next i

Hope this helps!
 
Upvote 0
Solution
Try the following...

VBA Code:
    Dim arr() As Variant
    arr() = Array("am34", "195", "bm34", "196", "cm34", "162") 'add your other ranges and corresponding numbers
  
    Dim i As Long
    For i = LBound(arr) To UBound(arr) Step 2
        If Range(arr(i)).Value = 1 Then
            With ActiveSheet.Shapes("Right Arrow " & arr(i + 1))
                .ThreeD.Visible = msoFalse
                .Fill.Visible = msoFalse
            End With
        ElseIf Range(arr(i)).Value = 2 Then
            With ActiveSheet.Shapes("Right Arrow " & arr(i + 1))
                .ThreeD.Visible = msoTrue
                .Fill.Visible = msoTrue
            End With
        End If
    Next i

Actually, it can also be written this way...

VBA Code:
    Dim arr() As Variant
    arr() = Array("am34", "195", "bm34", "196", "cm34", "162")
  
    Dim i As Long
    Dim flag As Long
    For i = LBound(arr) To UBound(arr) Step 2
        If Range(arr(i)).Value = 1 Then
            flag = msoFalse
        ElseIf Range(arr(i)).Value = 2 Then
            flag = msoTrue
        End If
        With ActiveSheet.Shapes("Right Arrow " & arr(i + 1))
            .ThreeD.Visible = flag
            .Fill.Visible = flag
        End With
    Next i

Hope this helps!
This is perfect - just what I was looking for. You saved me a ton of typing and no doubt speeded me up! Thank you very much for your help.

cheers, Iain
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,255
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top