VBA color change for Multiple squares

[Reinder]

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:

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?

 

[Fluff]

You can only have one change event per sheet, try

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]

You can only have one change event per sheet, try

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]

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]

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]

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]

You would need to put the change event on the sheet where you are manually changing the values and refer to the shapes like

Sheets("Sheet1").Shapes("Rectangle 4").Fill.ForeColor

Changing the Sheet1 to match the sheet names with the shapes.