There must be a way to shorten this!

m_in_spain

Board Regular
Joined
Sep 28, 2018
Messages
64
Office Version
  1. 365
Platform
  1. Windows
Hi
I have some shapes (arrows = called drop1, drop2.... etc) on my spreadsheet, which i want to appear/disappear depending on the value of cell C4. This below works ok but to me seems long winded, especially considering i need to add another hundred arrows or so, and then duplicate the whole thing for cell C7.
The only thing that changes is this end number for the shape. I have tried all manner of ways to change this but all fail. There must be a way! If any clever person can help I will be most grateful.

Code:
Private Sub Worksheet_Calculate()If Range("C4") = 3 Then
Me.Shapes("drop1").Visible = True
Me.Shapes("drop2").Visible = True
Me.Shapes("drop3").Visible = True
Me.Shapes("drop4").Visible = True
Me.Shapes("drop5").Visible = True
Me.Shapes("drop6").Visible = True
Me.Shapes("drop7").Visible = True
Me.Shapes("drop8").Visible = True
Else
Me.Shapes("drop1").Visible = False
Me.Shapes("drop2").Visible = False
Me.Shapes("drop3").Visible = False
Me.Shapes("drop4").Visible = False
Me.Shapes("drop5").Visible = False
Me.Shapes("drop6").Visible = False
Me.Shapes("drop7").Visible = False
Me.Shapes("drop8").Visible = False
End If
End Sub
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Hi, how about something like:

Code:
Private Sub Worksheet_Calculate()
Dim sh As Shape
For Each sh In Me.Shapes
    If sh.Name Like "drop*" Then sh.Visible = (Range("C4") = 3)
Next sh
End Sub
 
Upvote 0
You are a genius, it works like a dream, many thanks.

Now if i want some drops (for eg drop8) to appear when C6 is changed, but is unaffected by any change in C3
To me the obvious answer is to use a different name (for eg fall8 etc) but it would be nice to do it all neatly using just one description?

Thanks in advance!

Hi, how about something like:

Code:
Private Sub Worksheet_Calculate()
Dim sh As Shape
For Each sh In Me.Shapes
    If sh.Name Like "drop*" Then sh.Visible = (Range("C4") = 3)
Next sh
End Sub
 
Upvote 0
To me the obvious answer is to use a different name (for eg fall8 etc)

That sounds like a perfectly sensible way to do it, but if you really did want to hardcode the names of the shapes to exclude, you could do something like this.

Code:
Private Sub Worksheet_Calculate()
Dim exclude As Variant
exclude = Array("drop8", "drop10") '< Add more shape names to exclude here 
Dim sh As Shape
For Each sh In Me.Shapes
    If sh.Name Like "drop*" Then
        If Not IsNumeric(Application.Match(sh.Name, exclude, 0)) Then sh.Visible = (Range("C4") = 3)
    End If
Next sh
End Sub
 
Upvote 0
OK, many thanks again.
As i sometimes want them to appear, sometimes not i will go along with the different name for each set route.
Thanks again for your help
 
Upvote 0

Forum statistics

Threads
1,214,622
Messages
6,120,572
Members
448,972
Latest member
Shantanu2024

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