Consulting

Results 1 to 8 of 8

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

  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

  2. #2
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,050
    Location
    Actually the video is significantly different from the intent of your code. In Ah Sing's video, he is using a changing variable from a list in column A to effect a collection of shapes that make up the array. Here from your code all we can assume is that you are changing the fore colour of an array based on the variable cell C2 value.

    Since we are simply guessing here can you supply a sample workbook to make things easier?
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  3. #3
    Thanks for the response. I've attached a sample file with the first 8 lots and corresponding shapes. Code is the same but with updated shape name
    Attached Files Attached Files

  4. #4
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,189
    Location
    One method attached, i would not be that keen on it updating 250 shapes each time that one cell is changed in column A though - might be something to look at.
    Attached Files Attached Files
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2403, Build 17425.20146

  5. #5
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,050
    Location
    I must be way off then.... I was more or less thinking that each cell in the range A2:A9 was individually linked to a shape eg. Cell A2.value(394) was linked to the shape "shp394". Then depending on the value predefined by the "Construction Phase" list of values for each cell in the range C2:C9, a preselected fore colour was applied to that shape. Since linking multiple Ifs together is problematic, we could apply a Case select function and loop through this for each cell in the C2:C9 range.

    This way if the User decides to build the Lot numbers up to 150 or more so be it.
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  6. #6
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,189
    Location
    You may not be, I have just used my logic here and it may not be right.

    I have answered the title if you like, my logic told me that the bit on the right is just a colour key, the numbers in column A relate to he shape name.

    My understanding was to colour the shapes relating to the shape name in column A and the value in column C, looking up the value in column C in the key part on the right and using the colour of that key.

    Until the TS replies
    Last edited by georgiboy; 01-20-2023 at 05:11 AM. Reason: Changed OP to TS
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2403, Build 17425.20146

  7. #7
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,050
    Location
    Since we are parked in Neutral, I may as well turn the motor off.....
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  8. #8
    Wow thank you georgiboy, that's beautiful, works exactly how I need it to!
    I'll see how I fare with the additional shapes, but definitely solved. Certainly won't be ideal if the info in column A changes drastically, but luckily something I don't foresee.
    Thank you both for your help!

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
  •