arch_user
01-19-2023, 12:20 PM
I've found related projects and issues but I am new to VBA and am struggling, though I have managed to make the below code work.
In my project, column A has all lot #'s and column C shows current project status. Each lot has a shape shown on a map and each status designation is assigned a separate color.
The code below works, but I need to apply this to 150 cells and corresponding shapes (that show up on the map).
This video I found seems to be exactly what I need but is not working in my case: https://www.youtube.com/watch?v=fn1wYvvqpUk&t=1s
Thank you to anyone who might help with this...
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("C2") = "Rough Framing" Then
ActiveSheet.Shapes.Range(Array("LotAShape")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(252, 193, 106)
Else
If Range("C2") = "Permitting" Then
ActiveSheet.Shapes.Range(Array("Lot300Shape")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(250, 132, 108)
Else
If Range("C2") = "C/O" Then
ActiveSheet.Shapes.Range(Array("LotAShape")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(123, 242, 76)
Else
If Range("C2") = "Rough Mechanicals" Then
ActiveSheet.Shapes.Range(Array("LotAShape")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(252, 242, 106)
Else
If Range("C2") = "Finish Mechanicals" Then
ActiveSheet.Shapes.Range(Array("LotAShape")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(187, 253, 228)
Else
If Range("C2") = "Drywall" Then
ActiveSheet.Shapes.Range(Array("LotAShape")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(110, 186, 248)
Else
If Range("C2") = "Painting" Then
ActiveSheet.Shapes.Range(Array("LotAShape")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(208, 175, 235)
Else
If Range("C2") = "Punchout" Then
ActiveSheet.Shapes.Range(Array("LotAShape")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(243, 115, 191)
End If
End If
End If
End If
End If
End If
End If
End If
End Sub
In my project, column A has all lot #'s and column C shows current project status. Each lot has a shape shown on a map and each status designation is assigned a separate color.
The code below works, but I need to apply this to 150 cells and corresponding shapes (that show up on the map).
This video I found seems to be exactly what I need but is not working in my case: https://www.youtube.com/watch?v=fn1wYvvqpUk&t=1s
Thank you to anyone who might help with this...
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("C2") = "Rough Framing" Then
ActiveSheet.Shapes.Range(Array("LotAShape")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(252, 193, 106)
Else
If Range("C2") = "Permitting" Then
ActiveSheet.Shapes.Range(Array("Lot300Shape")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(250, 132, 108)
Else
If Range("C2") = "C/O" Then
ActiveSheet.Shapes.Range(Array("LotAShape")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(123, 242, 76)
Else
If Range("C2") = "Rough Mechanicals" Then
ActiveSheet.Shapes.Range(Array("LotAShape")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(252, 242, 106)
Else
If Range("C2") = "Finish Mechanicals" Then
ActiveSheet.Shapes.Range(Array("LotAShape")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(187, 253, 228)
Else
If Range("C2") = "Drywall" Then
ActiveSheet.Shapes.Range(Array("LotAShape")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(110, 186, 248)
Else
If Range("C2") = "Painting" Then
ActiveSheet.Shapes.Range(Array("LotAShape")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(208, 175, 235)
Else
If Range("C2") = "Punchout" Then
ActiveSheet.Shapes.Range(Array("LotAShape")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(243, 115, 191)
End If
End If
End If
End If
End If
End If
End If
End If
End Sub