VBA to change multiple shapes color in Excel

[waseem11]

I'm beginner in Excel so i'm looking for a way by which if I type yes in a cell it should change color of multiple shapes with same color and if I type NO it should remove the color from those shapes and same goes for other zone entries as show below image.
Example: If i type On in G22&25 it should color 3 circles always with same color which is green in this case and if i type off it should remove the color from that circle.

 

[DanteAmor]

Hi and welcome to MrExcel.

You help me with the following:
Instead of putting G2&25, you could put G2:G25.

The result will look like this:

Put the following code in the events of your sheet

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("D2:D" & Range("C" & Rows.Count).End(3).Row)) Is Nothing Then
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    
    Dim shp As Shape, rng As Range, rngShape As Range
    
    Set rng = Range(Target.Offset(, -1).Value)
    For Each shp In ActiveSheet.Shapes
      Set rngShape = Range(shp.TopLeftCell, shp.BottomRightCell)
      If Not Intersect(rngShape, rng) Is Nothing Then
        shp.Select
        If LCase(Target.Value) = LCase("On") Then
          Selection.Interior.Color = Target.Offset(, -1).Interior.Color
        Else
          Selection.Interior.ColorIndex = xlNone
        End If
      End If
    Next
    Target.Select
  End If
End Sub

SHEET EVENT
Right click the tab of the sheet you want this to work, select view code and paste the code into the window that opens up.

_______________________________________________________________________________________________
Change On or Off in column D, the shapes will automatically change color.

 

[waseem11]

Hi and welcome to MrExcel.

You help me with the following:
Instead of putting G2&25, you could put G2:G25.

The result will look like this:

View attachment 18045

Put the following code in the events of your sheet

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("D2:D" & Range("C" & Rows.Count).End(3).Row)) Is Nothing Then
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
   
    Dim shp As Shape, rng As Range, rngShape As Range
   
    Set rng = Range(Target.Offset(, -1).Value)
    For Each shp In ActiveSheet.Shapes
      Set rngShape = Range(shp.TopLeftCell, shp.BottomRightCell)
      If Not Intersect(rngShape, rng) Is Nothing Then
        shp.Select
        If LCase(Target.Value) = LCase("On") Then
          Selection.Interior.Color = Target.Offset(, -1).Interior.Color
        Else
          Selection.Interior.ColorIndex = xlNone
        End If
      End If
    Next
    Target.Select
  End If
End Sub

SHEET EVENT
Right click the tab of the sheet you want this to work, select view code and paste the code into the window that opens up.

_______________________________________________________________________________________________
Change On or Off in column D, the shapes will automatically change color.

Thank you so much for your response. I would like to clarify where can i mentioned about shape name in the code so i can correct it in my case.
you can check my shape names here though:

 

[DanteAmor]

Thank you so much for your response. I would like to clarify where can i mentioned about shape name in the code so i can correct it in my case.
you can check my shape names here though:

Can you comment why you want to put the shape name?

What do you mean by "Zone" is the cell range or is it the shape name?

 

[waseem11]

Since i'll have bundles of shapes like this where each zone shape will be more than one, like for G22&25 i've 8 circles at top arc and all of those 8 will have same green color. Similarly G2 and G6 will have the same green color but different circles linked to it.
I can use the same name as zones to shapes, if that's helpful.

 

[DanteAmor]

Sorry, it's very clear to you, but it's not clear to me.
So to clarify, what is "G22", is it a cell, is it the name of the shape, or is it text that is inside the shape?

 

[waseem11]

G22 is the cell name, it's not the shape name but we can gave it the shape name for easy understanding though.
The text inside the shape is just added for info, its not mandatory.

Hope that clears your query. Feel free to ask in case of any query again.

 

[DanteAmor]

G22&25

It's still confusing to me.
If G2 is a cell, what does it mean "G22&25"?

I don't know what your zones mean and how based on the zone you want to get to the shape.

I am very lost.
I understand that you have many zones.
Could you explain only 1.
I mean, in your area you have G22&25 (I still don't understand what that is)
in which way manually or visibly you identify which shapes should paint?

 

[waseem11]

G22&25 is the zone name and we can use same name for shapes as well which is shown on the extreme right. Shapes names can be different if required.
Since i've many zones so if i type ON in front of G22&25 zone cell, then it should only color the circles which are with shape names as G22&25 or the name givens to those circles as you can see in below screen.

 

[DanteAmor]

G22&25 is the zone name and we can use same name for shapes as well which is shown on the extreme right.

According to the above, try the following:

Put the code in the events of your sheet

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("D2:D" & Range("C" & Rows.Count).End(3).Row)) Is Nothing Then
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub

    Dim shp As Shape

    For Each shp In ActiveSheet.Shapes
      If shp.Name = Target.Offset(, -1).Value Then
        shp.Select
        If LCase(Target.Value) = LCase("On") Then
          Selection.Interior.Color = Target.Offset(, -1).Interior.Color
        Else
          Selection.Interior.ColorIndex = xlNone
        End If
      End If
    Next
    Target.Select
  End If
End Sub

SHEET EVENT
Right click the tab of the sheet you want this to work, select view code and paste the code into the window that opens up.

_______________________________________________________________________________________________
Change On or Off in column D, the shapes will automatically change color.