Worksheet_Change Help!

A

Adbuckner

New Member
Joined
Jul 10, 2017
Messages
1
I am writing a massive piece of code and it's too long to run worksheet_change, I'm hoping someone can see where I have been too verbose and skinny up the code a bit for me.. I've run out of things to try. the entirety of my code is below. Thanks in advance!

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("U3")) Is Nothing Then
Me.Shapes("Freeform 45").Select
With Range("U3")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("U4")) Is Nothing Then
Me.Shapes("Freeform 43").Select
With Range("U4")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("U5")) Is Nothing Then
Me.Shapes("Freeform 41").Select
With Range("U5")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("U6")) Is Nothing Then
Me.Shapes("Freeform 39").Select
With Range("U6")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("U7")) Is Nothing Then
Me.Shapes("Freeform 37").Select
With Range("U7")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("U8")) Is Nothing Then
Me.Shapes("Freeform 35").Select
With Range("U8")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("U9")) Is Nothing Then
Me.Shapes("Freeform 33").Select
With Range("U9")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W3")) Is Nothing Then
Me.Shapes("Freeform 4").Select
With Range("W3")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W4")) Is Nothing Then
Me.Shapes("Freeform 5").Select
With Range("W4")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W5")) Is Nothing Then
Me.Shapes("Freeform 6").Select
With Range("W5")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W6")) Is Nothing Then
Me.Shapes("Freeform 7").Select
With Range("W6")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W7")) Is Nothing Then
Me.Shapes("Freeform 8").Select
With Range("W7")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W8")) Is Nothing Then
Me.Shapes("Freeform 9").Select
With Range("W8")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W9")) Is Nothing Then
Me.Shapes("Freeform 10").Select
With Range("W9")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("Y3")) Is Nothing Then
Me.Shapes("Freeform 91").Select
With Range("Y3")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("Y4")) Is Nothing Then
Me.Shapes("Freeform 89").Select
With Range("Y4")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("Y5")) Is Nothing Then
Me.Shapes("Freeform 87").Select
With Range("Y5")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("Y6")) Is Nothing Then
Me.Shapes("Freeform 85").Select
With Range("Y6")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("Y7")) Is Nothing Then
Me.Shapes("Freeform 83").Select
With Range("Y7")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("Y8")) Is Nothing Then
Me.Shapes("Freeform 81").Select
With Range("Y8")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("Y9")) Is Nothing Then
Me.Shapes("Freeform 79").Select
With Range("Y9")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA3")) Is Nothing Then
Me.Shapes("Freeform 68").Select
With Range("AA3")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA4")) Is Nothing Then
Me.Shapes("Freeform 66").Select
With Range("AA4")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA5")) Is Nothing Then
Me.Shapes("Freeform 64").Select
With Range("AA5")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA6")) Is Nothing Then
Me.Shapes("Freeform 62").Select
With Range("AA6")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA7")) Is Nothing Then
Me.Shapes("Freeform 60").Select
With Range("AA7")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA8")) Is Nothing Then
Me.Shapes("Freeform 58").Select
With Range("AA8")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA9")) Is Nothing Then
Me.Shapes("Freeform 56").Select
With Range("AA9")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AC3")) Is Nothing Then
Me.Shapes("Freeform 114").Select
With Range("AC3")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AC4")) Is Nothing Then
Me.Shapes("Freeform 112").Select
With Range("AC4")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AC5")) Is Nothing Then
Me.Shapes("Freeform 110").Select
With Range("AC5")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AC6")) Is Nothing Then
Me.Shapes("Freeform 108").Select
With Range("AC6")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AC7")) Is Nothing Then
Me.Shapes("Freeform 106").Select
With Range("AC7")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AC8")) Is Nothing Then
Me.Shapes("Freeform 104").Select
With Range("AC8")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AC9")) Is Nothing Then
Me.Shapes("Freeform 102").Select
With Range("AC9")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AE3")) Is Nothing Then
Me.Shapes("Freeform 137").Select
With Range("AE3")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AE4")) Is Nothing Then
Me.Shapes("Freeform 135").Select
With Range("AE4")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AE5")) Is Nothing Then
Me.Shapes("Freeform 133").Select
With Range("AE5")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AE6")) Is Nothing Then
Me.Shapes("Freeform 131").Select
With Range("AE6")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AE7")) Is Nothing Then
Me.Shapes("Freeform 129").Select
With Range("AE7")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AE8")) Is Nothing Then
Me.Shapes("Freeform 127").Select
With Range("AE8")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AE9")) Is Nothing Then
Me.Shapes("Freeform 125").Select
With Range("AE9")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AG3")) Is Nothing Then
Me.Shapes("Freeform 206").Select
With Range("AG3")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AG4")) Is Nothing Then
Me.Shapes("Freeform 204").Select
With Range("AG4")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AG5")) Is Nothing Then
Me.Shapes("Freeform 202").Select
With Range("AG5")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AG6")) Is Nothing Then
Me.Shapes("Freeform 200").Select
With Range("AG6")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AG7")) Is Nothing Then
Me.Shapes("Freeform 198").Select
With Range("AG7")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AG8")) Is Nothing Then
Me.Shapes("Freeform 196").Select
With Range("AG8")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AG9")) Is Nothing Then
Me.Shapes("Freeform 194").Select
With Range("AG9")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("U12")) Is Nothing Then
Me.Shapes("Freeform 160").Select
With Range("U12")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("U13")) Is Nothing Then
Me.Shapes("Freeform 158").Select
With Range("U13")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("U14")) Is Nothing Then
Me.Shapes("Freeform 156").Select
With Range("U14")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("U15")) Is Nothing Then
Me.Shapes("Freeform 154").Select
With Range("U15")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("U16")) Is Nothing Then
Me.Shapes("Freeform 152").Select
With Range("U16")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("U17")) Is Nothing Then
Me.Shapes("Freeform 150").Select
With Range("U17")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("U18")) Is Nothing Then
Me.Shapes("Freeform 148").Select
With Range("U18")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W12")) Is Nothing Then
Me.Shapes("Freeform 229").Select
With Range("W12")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W13")) Is Nothing Then
Me.Shapes("Freeform 227").Select
With Range("W13")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W14")) Is Nothing Then
Me.Shapes("Freeform 225").Select
With Range("W14")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W15")) Is Nothing Then
Me.Shapes("Freeform 223").Select
With Range("W15")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W16")) Is Nothing Then
Me.Shapes("Freeform 221").Select
With Range("W16")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W17")) Is Nothing Then
Me.Shapes("Freeform 219").Select
With Range("W17")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W18")) Is Nothing Then
Me.Shapes("Freeform 217").Select
With Range("W18")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("Y12")) Is Nothing Then
Me.Shapes("Freeform 252").Select
With Range("Y12")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("Y13")) Is Nothing Then
Me.Shapes("Freeform 250").Select
With Range("Y13")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("Y14")) Is Nothing Then
Me.Shapes("Freeform 248").Select
With Range("Y14")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("Y15")) Is Nothing Then
Me.Shapes("Freeform 246").Select
With Range("Y15")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("Y16")) Is Nothing Then
Me.Shapes("Freeform 244").Select
With Range("Y16")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("Y17")) Is Nothing Then
Me.Shapes("Freeform 242").Select
With Range("Y17")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("Y18")) Is Nothing Then
Me.Shapes("Freeform 240").Select
With Range("Y18")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA12")) Is Nothing Then
Me.Shapes("Freeform 275").Select
With Range("AA12")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA13")) Is Nothing Then
Me.Shapes("Freeform 273").Select
With Range("AA13")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA14")) Is Nothing Then
Me.Shapes("Freeform 271").Select
With Range("AA14")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA15")) Is Nothing Then
Me.Shapes("Freeform 269").Select
With Range("AA15")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA16")) Is Nothing Then
Me.Shapes("Freeform 267").Select
With Range("AA16")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA17")) Is Nothing Then
Me.Shapes("Freeform 265").Select
With Range("AA17")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA18")) Is Nothing Then
Me.Shapes("Freeform 263").Select
With Range("AA18")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AC12")) Is Nothing Then
Me.Shapes("Freeform 298").Select
With Range("AC12")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AC13")) Is Nothing Then
Me.Shapes("Freeform 296").Select
With Range("AC13")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AC14")) Is Nothing Then
Me.Shapes("Freeform 294").Select
With Range("AC14")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AC15")) Is Nothing Then
Me.Shapes("Freeform 292").Select
With Range("AC15")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AC16")) Is Nothing Then
Me.Shapes("Freeform 290").Select
With Range("AC16")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AC17")) Is Nothing Then
Me.Shapes("Freeform 288").Select
With Range("AC17")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AC18")) Is Nothing Then
Me.Shapes("Freeform 286").Select
With Range("AC18")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AE12")) Is Nothing Then
Me.Shapes("Freeform 321").Select
With Range("AE12")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AE13")) Is Nothing Then
Me.Shapes("Freeform 319").Select
With Range("AE13")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AE14")) Is Nothing Then
Me.Shapes("Freeform 317").Select
With Range("AE14")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AE15")) Is Nothing Then
Me.Shapes("Freeform 315").Select
With Range("AE15")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AE16")) Is Nothing Then
Me.Shapes("Freeform 313").Select
With Range("AE16")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AE17")) Is Nothing Then
Me.Shapes("Freeform 311").Select
With Range("AE17")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AE18")) Is Nothing Then
Me.Shapes("Freeform 309").Select
With Range("AE18")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AG12")) Is Nothing Then
Me.Shapes("Freeform 344").Select
With Range("AG12")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AG13")) Is Nothing Then
Me.Shapes("Freeform 342").Select
With Range("AG13")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AG14")) Is Nothing Then
Me.Shapes("Freeform 340").Select
With Range("AG14")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AG15")) Is Nothing Then
Me.Shapes("Freeform 338").Select
With Range("AG15")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AG16")) Is Nothing Then
Me.Shapes("Freeform 336").Select
With Range("AG16")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AG17")) Is Nothing Then
Me.Shapes("Freeform 334").Select
With Range("AG17")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AG18")) Is Nothing Then
Me.Shapes("Freeform 332").Select
With Range("AG18")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W21")) Is Nothing Then
Me.Shapes("Freeform 392").Select
With Range("W21")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W22")) Is Nothing Then
Me.Shapes("Freeform 390").Select
With Range("W22")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W23")) Is Nothing Then
Me.Shapes("Freeform 388").Select
With Range("W23")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W24")) Is Nothing Then
Me.Shapes("Freeform 386").Select
With Range("W24")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W25")) Is Nothing Then
Me.Shapes("Freeform 384").Select
With Range("W25")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W26")) Is Nothing Then
Me.Shapes("Freeform 382").Select
With Range("W26")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W27")) Is Nothing Then
Me.Shapes("Freeform 380").Select
With Range("W27")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA21")) Is Nothing Then
Me.Shapes("Freeform 378").Select
With Range("AA21")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA22")) Is Nothing Then
Me.Shapes("Freeform 376").Select
With Range("AA22")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA23")) Is Nothing Then
Me.Shapes("Freeform 374").Select
With Range("AA23")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA24")) Is Nothing Then
Me.Shapes("Freeform 372").Select
With Range("AA24")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA25")) Is Nothing Then
Me.Shapes("Freeform 370").Select
With Range("AA25")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA26")) Is Nothing Then
Me.Shapes("Freeform 347").Select
With Range("AA26")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA27")) Is Nothing Then
Me.Shapes("Freeform 330").Select
With Range("AA27")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("U31")) Is Nothing Then
Me.Shapes("Freeform 305").Select
With Range("U31")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("U32")) Is Nothing Then
Me.Shapes("Freeform 307").Select
With Range("U32")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("U33")) Is Nothing Then
Me.Shapes("Freeform 308").Select
With Range("U33")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("U34")) Is Nothing Then
Me.Shapes("Freeform 310").Select
With Range("U34")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W31")) Is Nothing Then
Me.Shapes("Freeform 297").Select
With Range("W31")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W32")) Is Nothing Then
Me.Shapes("Freeform 300").Select
With Range("W32")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W33")) Is Nothing Then
Me.Shapes("Freeform 303").Select
With Range("W33")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W34")) Is Nothing Then
Me.Shapes("Freeform 304").Select
With Range("W34")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("Y31")) Is Nothing Then
Me.Shapes("Freeform 584").Select
With Range("Y31")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("Y32")) Is Nothing Then
Me.Shapes("Freeform 585").Select
With Range("Y32")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("Y33")) Is Nothing Then
Me.Shapes("Freeform 586").Select
With Range("Y33")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("Y34")) Is Nothing Then
Me.Shapes("Freeform 587").Select
With Range("Y34")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA31")) Is Nothing Then
Me.Shapes("Freeform 580").Select
With Range("AA31")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA32")) Is Nothing Then
Me.Shapes("Freeform 581").Select
With Range("AA32")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA33")) Is Nothing Then
Me.Shapes("Freeform 582").Select
With Range("AA33")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA34")) Is Nothing Then
Me.Shapes("Freeform 583").Select
With Range("AA34")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AC31")) Is Nothing Then
Me.Shapes("Freeform 631").Select
With Range("AC31")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AC32")) Is Nothing Then
Me.Shapes("Freeform 632").Select
With Range("AC32")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AC33")) Is Nothing Then
Me.Shapes("Freeform 633").Select
With Range("AC33")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AC34")) Is Nothing Then
Me.Shapes("Freeform 634").Select
With Range("AC34")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AE31")) Is Nothing Then
Me.Shapes("Freeform 652").Select
With Range("AE31")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AE32")) Is Nothing Then
Me.Shapes("Freeform 653").Select
With Range("AE32")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AE33")) Is Nothing Then
Me.Shapes("Freeform 654").Select
With Range("AE33")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AE34")) Is Nothing Then
Me.Shapes("Freeform 635").Select
With Range("AE34")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA31")) Is Nothing Then
Me.Shapes("Freeform 580").Select
With Range("AA31")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA32")) Is Nothing Then
Me.Shapes("Freeform 581").Select
With Range("AA32")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA33")) Is Nothing Then
Me.Shapes("Freeform 582").Select
With Range("AA33")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA34")) Is Nothing Then
Me.Shapes("Freeform 583").Select
With Range("AA34")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AG31")) Is Nothing Then
Me.Shapes("Freeform 648").Select
With Range("AG31")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AG32")) Is Nothing Then
Me.Shapes("Freeform 649").Select
With Range("AG32")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AG33")) Is Nothing Then
Me.Shapes("Freeform 650").Select
With Range("AG33")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AG34")) Is Nothing Then
Me.Shapes("Freeform 651").Select
With Range("AG34")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("U39")) Is Nothing Then
Me.Shapes("Freeform 635").Select
With Range("U39")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("U40")) Is Nothing Then
Me.Shapes("Freeform 636").Select
With Range("U40")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("U41")) Is Nothing Then
Me.Shapes("Freeform 637").Select
With Range("U41")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("U42")) Is Nothing Then
Me.Shapes("Freeform 638").Select
With Range("U42")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W39")) Is Nothing Then
Me.Shapes("Freeform 665").Select
With Range("W39")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W40")) Is Nothing Then
Me.Shapes("Freeform 666").Select
With Range("W40")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W41")) Is Nothing Then
Me.Shapes("Freeform 667").Select
With Range("W41")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W42")) Is Nothing Then
Me.Shapes("Freeform 668").Select
With Range("W42")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("Y39")) Is Nothing Then
Me.Shapes("Freeform 669").Select
With Range("Y39")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("Y40")) Is Nothing Then
Me.Shapes("Freeform 670").Select
With Range("Y40")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("Y41")) Is Nothing Then
Me.Shapes("Freeform 671").Select
With Range("Y41")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("Y42")) Is Nothing Then
Me.Shapes("Freeform 672").Select
With Range("Y42")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA39")) Is Nothing Then
Me.Shapes("Freeform 682").Select
With Range("AA39")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA40")) Is Nothing Then
Me.Shapes("Freeform 683").Select
With Range("AA40")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA41")) Is Nothing Then
Me.Shapes("Freeform 684").Select
With Range("AA41")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA42")) Is Nothing Then
Me.Shapes("Freeform 684").Select
With Range("AA42")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AC39")) Is Nothing Then
Me.Shapes("Freeform 686").Select
With Range("AC39")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AC40")) Is Nothing Then
Me.Shapes("Freeform 687").Select
With Range("AC40")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AC41")) Is Nothing Then
Me.Shapes("Freeform 688").Select
With Range("AC41")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AC42")) Is Nothing Then
Me.Shapes("Freeform 689").Select
With Range("AC42")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AE39")) Is Nothing Then
Me.Shapes("Freeform 614").Select
With Range("AE39")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AE40")) Is Nothing Then
Me.Shapes("Freeform 615").Select
With Range("AE40")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AE41")) Is Nothing Then
Me.Shapes("Freeform 616").Select
With Range("AE41")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AE42")) Is Nothing Then
Me.Shapes("Freeform 617").Select
With Range("AE42")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AG39")) Is Nothing Then
Me.Shapes("Freeform 618").Select
With Range("AG39")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AG40")) Is Nothing Then
Me.Shapes("Freeform 619").Select
With Range("AG40")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AG41")) Is Nothing Then
Me.Shapes("Freeform 620").Select
With Range("AG41")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AG42")) Is Nothing Then
Me.Shapes("Freeform 621").Select
With Range("AG42")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W48")) Is Nothing Then
Me.Shapes("Freeform 597").Select
With Range("W48")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W49")) Is Nothing Then
Me.Shapes("Freeform 598").Select
With Range("W49")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W50")) Is Nothing Then
Me.Shapes("Freeform 599").Select
With Range("W50")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("W51")) Is Nothing Then
Me.Shapes("Freeform 600").Select
With Range("W51")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA48")) Is Nothing Then
Me.Shapes("Freeform 601").Select
With Range("AA48")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA49")) Is Nothing Then
Me.Shapes("Freeform 602").Select
With Range("AA49")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA50")) Is Nothing Then
Me.Shapes("Freeform 603").Select
With Range("AA50")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
If Not Intersect(Target, Range("AA51")) Is Nothing Then
Me.Shapes("Freeform 604").Select
With Range("AA51")
If .Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
.Select
End With
End If
End Sub
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Sort by date Sort by votes
Hi Adbuckner,

Some thoughts:

1. I don't think there is any real problem with putting all your code in the worksheet_change event.
2. There is a real problem in writing un-indented code as it makes it almost impossible to decipher - a bit like writing a book with no paragraphs or sentences!
3. The short piece of code below will show you how to structure your answer. The key bit is that you can calculate which of the freeform shapes you want to use, but the logic that assigns a particular shape to a cell is unclear to me so I've simply calculated it for the first set of cells:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("U3:U9")) Is Nothing Then
        Me.Shapes("Freeform " & 45 - (Target.Row - 3) * 2).Select
        With Target
            If .Value = 1 Then
                Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)
            Else
                Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 128, 0)
            End If
            .Select
        End With
    End If
End Sub

Perhaps the key things to note are the use of 'target' rather than explicitly defining a Range for each cell and considering how you calculate the number by amending this piece of code: Me.Shapes("Freeform " & 45 - (Target.Row - 3) * 2)

That should help you create the solution.

Regards

Peter
 
Upvote 0
You could shorten your code by writing it like this:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("U3")) Is Nothing Then
If Target.Value = 1 Then Me.Shapes("Freeform 45").Fill.ForeColor.RGB = RGB(255, 0, 0)
If Target.Value <> 1 Then Me.Shapes("Freeform 45").Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
If Not Intersect(Target, Range("U4")) Is Nothing Then
If Target.Value = 1 Then Me.Shapes("Freeform 43").Fill.ForeColor.RGB = RGB(255, 0, 0)
If Target.Value <> 1 Then Me.Shapes("Freeform 43").Fill.ForeColor.RGB = RGB(0, 128, 0)
End If
End Sub
 
Upvote 0
Hi My Aswer Is this,

Can I suggest that my solution is better (apologies for criticising). The section of code I've submitted will replace 77 lines with 11, whereas your version would result in 28 (if I've got my sums correct).

However, you've made me think of an alternative approach. Firstly in the Worksheet_Change event:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("U3")) Is Nothing Then
        setShape bTgtState:=Target.Value, tgtShape:="Freeform 45"
        
    ElseIf Not Intersect(Target, Range("U4")) Is Nothing Then
        setShape bTgtState:=Target.Value, tgtShape:="Freeform 43"
        
    ElseIf Not Intersect(Target, Range("U5")) Is Nothing Then
        setShape bTgtState:=Target.Value, tgtShape:="Freeform 41"
        
    ElseIf Not Intersect(Target, Range("U6")) Is Nothing Then
        setShape bTgtState:=Target.Value, tgtShape:="Freeform 39"
        
    ElseIf Not Intersect(Target, Range("U7")) Is Nothing Then
        setShape bTgtState:=Target.Value, tgtShape:="Freeform 37"
        
    ElseIf Not Intersect(Target, Range("U8")) Is Nothing Then
        setShape bTgtState:=Target.Value, tgtShape:="Freeform 35"
        
    ElseIf Not Intersect(Target, Range("U9")) Is Nothing Then
        setShape bTgtState:=Target.Value, tgtShape:="Freeform 33"
        
    End If
End Sub


then in a module:

Code: 
Sub setShape(bTgtState As Integer, tgtShape As String)
    If bTgtState = 1 Then
        Me.Shapes(tgtShape).Fill.ForeColor.RGB = RGB(255, 0, 0)
    Else
        Me.Shapes(tgtShape).Fill.ForeColor.RGB = RGB(0, 128, 0)
    End If
End Sub

This has the advantage that the entire change event code isn't executed since once the Target cell is matched the setShape will run and the event will then jump to the endif and finish.

Just another take on the problem. I still think the calculated approach to identifying the shape will result in the most elegant solution, but that may not be possible.

Regards
 
Upvote 0
If I understand your script correctly your assuming the user is selecting the shape.
I don't see any where in his post where he says he is doing that. But then maybe I do not understand what your script is doing and I also realize after being on this Forum for years there is always someone with a shorter and faster way of doing things. And thanks for your shorter script.


pjmorris said:
Hi My Aswer Is this,

Can I suggest that my solution is better (apologies for criticising). The section of code I've submitted will replace 77 lines with 11, whereas your version would result in 28 (if I've got my sums correct).

However, you've made me think of an alternative approach. Firstly in the Worksheet_Change event:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("U3")) Is Nothing Then
        setShape bTgtState:=Target.Value, tgtShape:="Freeform 45"
        
    ElseIf Not Intersect(Target, Range("U4")) Is Nothing Then
        setShape bTgtState:=Target.Value, tgtShape:="Freeform 43"
        
    ElseIf Not Intersect(Target, Range("U5")) Is Nothing Then
        setShape bTgtState:=Target.Value, tgtShape:="Freeform 41"
        
    ElseIf Not Intersect(Target, Range("U6")) Is Nothing Then
        setShape bTgtState:=Target.Value, tgtShape:="Freeform 39"
        
    ElseIf Not Intersect(Target, Range("U7")) Is Nothing Then
        setShape bTgtState:=Target.Value, tgtShape:="Freeform 37"
        
    ElseIf Not Intersect(Target, Range("U8")) Is Nothing Then
        setShape bTgtState:=Target.Value, tgtShape:="Freeform 35"
        
    ElseIf Not Intersect(Target, Range("U9")) Is Nothing Then
        setShape bTgtState:=Target.Value, tgtShape:="Freeform 33"
        
    End If
End Sub


then in a module:

Code: 
Sub setShape(bTgtState As Integer, tgtShape As String)
    If bTgtState = 1 Then
        Me.Shapes(tgtShape).Fill.ForeColor.RGB = RGB(255, 0, 0)
    Else
        Me.Shapes(tgtShape).Fill.ForeColor.RGB = RGB(0, 128, 0)
    End If
End Sub

This has the advantage that the entire change event code isn't executed since once the Target cell is matched the setShape will run and the event will then jump to the endif and finish.

Just another take on the problem. I still think the calculated approach to identifying the shape will result in the most elegant solution, but that may not be possible.

Regards
Click to expand...
 
Upvote 0
Hi

The code shouldn't require the user to select the shape. Once they've changed a cell the worksheet_change event will run. The first code will identify which cell has been changed and then pass its value 'target.value" and the predefined shape name 'Freeform 45" for example, to the setShape routine. That will then test the target.value and determine which colour to set the shape too.

I am a little concerned that by having moved the colour setting to the module the Me.Shapes... element will fail as it will not understand to what 'Me.' refers. Unfortunately I don't have a set of shapes to test it on, but i'd hazard a guess that it should be something like:

Code: 
Sub setShape(bTgtState As Integer, tgtShape As String)
    If bTgtState = 1 Then
        ActiveSheet.Shapes(tgtShape).Fill.ForeColor.RGB = RGB(255, 0, 0)
    Else
        ActiveSheet.Shapes(tgtShape).Fill.ForeColor.RGB = RGB(0, 128, 0)
    End If
End Sub

regards
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
Excel VBA - Color the shapes when shape is selected
Replies
5
Views
688
jalmbris
J
G
  • Question
Highlight cross section/interest of current cell in table
Replies
1
Views
232
DanteAmor
DanteAmor
R
  • Question
Cannot Force UDF to Calculate
Replies
2
Views
300
RichardBX
R
R
  • Solved
change color of a cell, depending on value
Replies
5
Views
464
Georgiboy
Georgiboy
K
  • Question
When I Click cell C8, I should see the command button shown in E8 not otherwise via vba coding
Replies
5
Views
342
Jimmypop
Jimmypop

Forum statistics

Threads
1,214,627
Messages
6,120,610
Members
448,973
Latest member
ChristineC

Share this page

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