Conditional Formatting a Shape in Excel

Question

Hi All,

I am trying to apply Conditional Formatting of Shape containing Specific text, for this example its "Beta" & "Gamma". Any Shape containing Beta should be Red and Gamma should be Green . Copied this code from different source which was applicable for 1 color, trying to add 2nd color to the code, but getting error. Please help

................................................................................................

Sub ShapeColor()

Dim Shp As Shape

For Each Shp In Sheets("Sheet2").Shapes

  If InStr(1, Shp.TextFrame.Characters.Caption, "Beta", vbTextCompare) > 0 Then Shp.Fill.ForeColor.RGB = 15675 

  ElseIf InStr(1, Shp.TextFrame.Characters.Caption, "Gamma", vbTextCompare) > 0 Then Shp.Fill.ForeColor.RGB = 55675 

Next Shp

End Sub

Answer 1

You'll have to allow macros when you open the workbook. One way to do that is to make the folder that contains the workbook a trusted location for Excel (File > Options > Trust Center > Trust Center Settings... > Trusted Locations).

This code works for me in your workbook:

Sub ShapeColor()
   Dim Shp As Shape
   For Each Shp In Sheets("Sheet2").Shapes
      If InStr(1, Shp.TextFrame2.TextRange.Text, "1", vbTextCompare) > 0 Then
          Shp.Fill.ForeColor.RGB = 2550
      ElseIf InStr(1, Shp.TextFrame2.TextRange.Text, "2", vbTextCompare) > 0 Then
          Shp.Fill.ForeColor.RGB = 25512
      ElseIf InStr(1, Shp.TextFrame2.TextRange.Text, "3", vbTextCompare) > 0 Then
          Shp.Fill.ForeColor.RGB = 255255
      ElseIf InStr(1, Shp.TextFrame2.TextRange.Text, "4", vbTextCompare) > 0 Then
          Shp.Fill.ForeColor.RGB = 155255
      ElseIf InStr(1, Shp.TextFrame2.TextRange.Text, "5", vbTextCompare) > 0 Then
          Shp.Fill.ForeColor.RGB = 25534
      End If
   Next Shp
End Sub

Answer 2

The original was the one-line version of If ... Then. Since you now have multiple lines, it should look like this:

Sub ShapeColor()
   Dim Shp As Shape
   For Each Shp In Sheets("Sheet2").Shapes
      If InStr(1, Shp.TextFrame.Characters.Caption, "Beta", vbTextCompare) > 0 Then
          Shp.Fill.ForeColor.RGB = 15675
      ElseIf InStr(1, Shp.TextFrame.Characters.Caption, "Gamma", vbTextCompare) > 0 Then
          Shp.Fill.ForeColor.RGB = 55675
      End If
   Next Shp
End Sub

Answer 3

Hi HansV,

The Macros was working fine last month, but when I tried to run it today it gave me the error :

1. System error &h80070057 (-2147024809). The Parameter is incorrect.
2. Run time error 5 invalid procedure call or argument

Just to let you know I already have listed the File location as Trusted Location - Excel (File > Options > Trust Center > Trust Center Settings... > Trusted Locations).

Attaching the link for the working file:

https://drive.google.com/file/d/1LIvy8\_QdGVYXBo7wo9ac5lmcdUmYxx4s/view?usp=drivesdk

Regards,

Answer 4

Hi HansV,

The VBA Code was working fine on the test sheet, but when I used it on my worksheet it is throwing multiple errors.

1. Application defined or object defined error.
2. Microsoft has blocked macros from running because the source of the file is untrusted.

Please help in resolving the errors or any possible work around.

I am attaching the download link of worksheet for you to test if possible. Its a Construction Project Tracker.

https://drive.google.com/file/d/12TY-TQJM5H1rPC7LVxRcwQKWNLtCcofw/view?usp=drivesdk

Answer 5

Thanks a ton HansV, this works like a charm!

The original was the one-line version of If ... Then. Since you now have multiple lines, it should look like this:

Sub ShapeColor()
   Dim Shp As Shape
   For Each Shp In Sheets("Sheet2").Shapes
      If InStr(1, Shp.TextFrame.Characters.Caption, "Beta", vbTextCompare) > 0 Then
          Shp.Fill.ForeColor.RGB = 15675
      ElseIf InStr(1, Shp.TextFrame.Characters.Caption, "Gamma", vbTextCompare) > 0 Then
          Shp.Fill.ForeColor.RGB = 55675
      End If
   Next Shp
End Sub