none
Fill the shape with color if the text inside it is similar to text in a clicked cell. RRS feed

  • Question

  • Fluff13,
    I have multiple shapes linked to cell as text box. When I select say Cell A1 rectangle 20 which is linked to it will be filled with green color. However, I have more than 200 rectangles and I want this process to be automatic without individually typing a code for each shape linked to cell. Each text in every rectangle is linked to any cell with similar text in Column A. That means if one of the cell clicked in column A has the same text inside one of the shapes, then that corresponding shape will be filled with green color. The code below is functions well but it gets an error when some or all the shapes are grouped together. Any advice? Thank you.

    Here's the code I 

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
       Dim Shp As Shape
      
       If Target.CountLarge > 1 Then Exit Sub
       If Not Intersect(Target, Range("A2:A200")) Is Nothing Then
          For Each Shp In Me.Shapes
             If Trim(Shp.DrawingObject.Formula) = Target.Address Then
                Shp.fill.ForeColor.RGB = vbGreen
             Else
                Shp.fill.ForeColor.RGB = vbWhite
             End If
          Next Shp
       End If
    End Sub

    Thursday, June 13, 2019 4:11 AM

Answers

  • Kenocut --

    You erroneously posted your Excel VBA question in a user forum dedicated to questions about Microsoft Project Server, an enterprise project management application.  I would recommend you repost your question in one of the Excel user forums.  Hope this helps.


    Dale A. Howard [MVP]

    Thursday, June 13, 2019 1:02 PM
    Moderator

All replies

  • Kenocut --

    You erroneously posted your Excel VBA question in a user forum dedicated to questions about Microsoft Project Server, an enterprise project management application.  I would recommend you repost your question in one of the Excel user forums.  Hope this helps.


    Dale A. Howard [MVP]

    Thursday, June 13, 2019 1:02 PM
    Moderator
  • thanks
    Friday, June 14, 2019 12:06 AM