VBA color change for Multiple squares

Reinder

New Member
Joined
Nov 23, 2007
Messages
23
I have multiple shapes in my sheet and would like to change the color of each based in the value of specific cells. One I get but more is becoming a problem:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Range("H14")) Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) Then
        If Target.Value = "5" Then
            ActiveSheet.Shapes("Rectangle 4").Fill.ForeColor.RGB = vbGreen
        ElseIf Target.Value = "2" Then
            ActiveSheet.Shapes("Rectangle 4").Fill.ForeColor.RGB = vbYellow
ElseIf Target.Value = "3" Then
            ActiveSheet.Shapes("Rectangle 4").Fill.ForeColor.RGB = vbYellow
        ElseIf Target.Value = "4" Then
            ActiveSheet.Shapes("Rectangle 4").Fill.ForeColor.RGB = vbBlue
        Else
            ActiveSheet.Shapes("Rectangle 4").Fill.ForeColor.RGB = vbRed
        End If
    End If
    
        
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Range("H6")) Is Nothing Then Exit Sub
    If IsNumeric(Target.Vale) Then
        If Target.Value = "5" Then
            ActiveSheet.Shapes("Rectangle 7").Fill.ForeColor.RGB = vbGreen
        ElseIf Target.Value = "2" Then
            ActiveSheet.Shapes("Rectangle 7").Fill.ForeColor.RGB = vbYellow
ElseIf Target.Value = "3" Then
            ActiveSheet.Shapes("Rectangle 7").Fill.ForeColor.RGB = vbYellow
        ElseIf Target.Value = "4" Then
            ActiveSheet.Shapes("Rectangle 7").Fill.ForeColor.RGB = vbBlue
        Else
            ActiveSheet.Shapes("Rectangle 7").Fill.ForeColor.RGB = vbRed
        End If
    End If
        
End Sub

How to fix this?
 

Some videos you may like

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,301
Office Version
  1. 365
Platform
  1. Windows
You can only have one change event per sheet, try
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Not IsNumeric(Target.Value) Then Exit Sub
   If Target.Address(0, 0) = "H14" Then
      With Me.Shapes("Rectangle 4").Fill.ForeColor
         Select Case Target.Value
            Case 5: .RGB = vbGreen
            Case 2, 3: .RGB = vbYellow
            Case 4: .RGB = vbBlue
            Case Else: .RGB = vbRed
         End Select
      End With
   ElseIf Target.Address(0, 0) = "H6" Then
      With Me.Shapes("Rectangle 7").Fill.ForeColor
         Select Case Target.Value
            Case 5: .RGB = vbGreen
            Case 2, 3: .RGB = vbYellow
            Case 4: .RGB = vbBlue
            Case Else: .RGB = vbRed
         End Select
      End With
   End With
End Sub
 

Reinder

New Member
Joined
Nov 23, 2007
Messages
23
You can only have one change event per sheet, try
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Not IsNumeric(Target.Value) Then Exit Sub
   If Target.Address(0, 0) = "H14" Then
      With Me.Shapes("Rectangle 4").Fill.ForeColor
         Select Case Target.Value
            Case 5: .RGB = vbGreen
            Case 2, 3: .RGB = vbYellow
            Case 4: .RGB = vbBlue
            Case Else: .RGB = vbRed
         End Select
      End With
   ElseIf Target.Address(0, 0) = "H6" Then
      With Me.Shapes("Rectangle 7").Fill.ForeColor
         Select Case Target.Value
            Case 5: .RGB = vbGreen
            Case 2, 3: .RGB = vbYellow
            Case 4: .RGB = vbBlue
            Case Else: .RGB = vbRed
         End Select
      End With
   End With
End Sub
It worked, tx a million! (1 small fix, the last End With should be an End if ;))
 

Reinder

New Member
Joined
Nov 23, 2007
Messages
23
Ok, seems not to be perfect yet. The numbers in the designated fields (H14 for example) are retrieved from another sheet. If I change them there, the numbers change but the shape does not change color (only when I change it manually in that field).
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,301
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

If the cells contain a formula, then that will not trigger the change event, as the cell has not changed.
You would either need to run it from a calculate event, which will trigger whenever any cell on that sheet recalculates, or from a change evnt on the other sheet.
 

Reinder

New Member
Joined
Nov 23, 2007
Messages
23
If the cells contain a formula, then that will not trigger the change event, as the cell has not changed.
You would either need to run it from a calculate event, which will trigger whenever any cell on that sheet recalculates, or from a change evnt on the other sheet.
Can I not point to a cell in another sheet instead of the current one? and if so, how (as a reference doesn't work). If not, then how do I create a calculate event?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,301
Office Version
  1. 365
Platform
  1. Windows
You would need to put the change event on the sheet where you are manually changing the values and refer to the shapes like
VBA Code:
Sheets("Sheet1").Shapes("Rectangle 4").Fill.ForeColor
Changing the Sheet1 to match the sheet names with the shapes.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,105
Messages
5,622,758
Members
415,926
Latest member
jerrynababa

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
Top