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:
How to fix this?
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?