Apply conditional formatting to all shapes on a sheet

[Knockoutpie]

Is there any way to apply conditional formatting to all shapes in a sheet?

I have about 100 ovals who's shape names range from "oval 1" to "oval 100" etc..

The ovals all reference a cell which will return a number 1-4

is there a way to apply conditional formatting to these? 1 = green, 2 = yellow, 3 = orange, 4 = red..

 

[DanteAmor]

The ovals all reference a cell which will return a number 1-4

I have a couple of questions regarding your description:
- What kind of oval do you have, that is, how do you insert it into the sheet?
- How do you reference the cell?

Not possible with conditional formatting.

If you have a shape and within the shape the text "1", "2", "3" or "4" then run the following macro to color all the shapes on the sheet:

Sub colorshape()
  Dim sh As Shape
  Dim n As Variant, s As Variant, nrgb As Variant
  
  Application.ScreenUpdating = False
  
  For Each sh In ActiveSheet.Shapes
    n = sh.AutoShapeType
    If n = 9 Then
      nrgb = ""
      s = sh.TextFrame2.TextRange.Text
      Select Case s
        Case "1": nrgb = RGB(0, 176, 80)    'green
        Case "2": nrgb = RGB(255, 255, 0)   'yellow
        Case "3": nrgb = RGB(255, 192, 0)   'orange
        Case "4": nrgb = RGB(255, 0, 0)     'red
      End Select
      
      If nrgb <> "" Then sh.Fill.ForeColor.RGB = nrgb
    End If
  Next
  Application.ScreenUpdating = True
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------

 

[Knockoutpie]

I have a couple of questions regarding your description:
- What kind of oval do you have, that is, how do you insert it into the sheet?
- How do you reference the cell?

Not possible with conditional formatting.

If you have a shape and within the shape the text "1", "2", "3" or "4" then run the following macro to color all the shapes on the sheet:

Sub colorshape()
  Dim sh As Shape
  Dim n As Variant, s As Variant, nrgb As Variant
 
  Application.ScreenUpdating = False
 
  For Each sh In ActiveSheet.Shapes
    n = sh.AutoShapeType
    If n = 9 Then
      nrgb = ""
      s = sh.TextFrame2.TextRange.Text
      Select Case s
        Case "1": nrgb = RGB(0, 176, 80)    'green
        Case "2": nrgb = RGB(255, 255, 0)   'yellow
        Case "3": nrgb = RGB(255, 192, 0)   'orange
        Case "4": nrgb = RGB(255, 0, 0)     'red
      End Select
     
      If nrgb <> "" Then sh.Fill.ForeColor.RGB = nrgb
    End If
  Next
  Application.ScreenUpdating = True
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------

Dante, my guy, that works perfect.

You always have perfect answers.

 

[bradhnz]

Hello, is there something I need to change to apply this to all shapes the text references a cell.
Each paddock on the map should change colour to the reference in the shape. This will be between 1 & 20.
Thanks

 

[bradhnz]

Sorry that last post wastnt clear.
As I am using the cell reference for my text cell and not the text.frame2 I need to change it to look at
's = sh.Shapes.Range(Array("Freeform 24")).Select.

Any ideas appreciated