Consulting

Results 1 to 8 of 8

Thread: Shape Colors Updated per Cell Value (150 cells and shapes)

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1

    Shape Colors Updated per Cell Value (150 cells and shapes)

    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
    Last edited by Aussiebear; 01-19-2023 at 01:44 PM. Reason: Added code tags to supplied code

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •