vba apply icon set with conditional formatting

[ww4612]

Hello,
I try to use conditional formation to apply traffic light icon, based on cell value.
value => 70 and value<=100 green light
value => 40 and value<70 yellow light
value => 0 and value<40 red light
my current code is like:

Sub col()
ThisWorkbook.Sheets("score").Activate
For l = 2 To Application.WorksheetFunction.CountIf(Range(Cells(1, 1), Cells(1, Columns.Count)), "*")
For r = 2 To Application.WorksheetFunction.CountIf(Range(Cells(1, 1), Cells(Rows.Count, 1)), "*")
If Cells(r, l).Value < 40 And Cells(r, l).Value >= 0 Then
    With Cells(r, l)
    .IconCriteria = IconSets(xl3TrafficLights1)
    .Font.Color = vbBlack
    .Font.Bold = True
    End With
End If
If Cells(r, l).Value >= 40 And Cells(r, l).Value < 70 Then
    With Cells(r, l)
    .IconCriteria = IconSets(xl3TrafficLights1)
    .Font.Color = vbBlack
    .Font.Bold = True
    End With
End If
If Cells(r, l).Value >= 70 And Cells(r, l).Value <= 100 Then
    With Cells(r, l)
    .IconCriteria = IconSets(xl3TrafficLights1)
    .Font.Color = vbBlack
    .Font.Bold = True
    End With
End If
Next r
Next l
End Sub

The following code is not valid.

.IconCriteria = IconSets(xl3TrafficLights1)

Any idea how to write the valid code?

 

[Jerry Sullivan]

Hi ww4612,

If you are wanting to use VBA to apply Excel's Conditional Formatting(CF) feature, then the VBA code doesn't need to step through and evaluate the value of each cell. It just needs to apply the CF rule and let the CF feature do the evaluation.

Here's an example of the syntax used to add CF with Icon Sets to a range.

Sub ApplyIconSetCF()
   Dim rRangeToFormat As Range
   Dim ic As IconCriteria
   
   '--modify to the desired range
   Set rRangeToFormat = Range("A1:D100")
   
   With rRangeToFormat
      With .FormatConditions
      '--clear any existing CF
         .Delete
         .AddIconSetCondition
      End With
      With .FormatConditions(1)
         .SetFirstPriority
         .ReverseOrder = False
         .ShowIconOnly = False
         .IconSet = ActiveWorkbook.IconSets(xl3TrafficLights1)
         With .IconCriteria(2)
            .Type = xlConditionValueNumber
            .Value = 40
            .Operator = xlGreaterEqual
         End With
         With .IconCriteria(3)
            .Type = xlConditionValueNumber
            .Value = 70
            .Operator = xlGreaterEqual
         End With
      End With
   End With
End Sub

 

[ww4612]

i followed your instruction. and i wrote things like

With Cells(r, l).FormatConditions(1)
    .ReverseOrder = False
    .ShowIconOnly = False
    .IconSet = ActiveWorkbook.IconSets(xl3TrafficLights1)
    With .IconCriteria(2)
        .Type = xlConditionValueNumber
        .Value = 4
        .Operator = 7
    End With
    With .IconCriteria(3)
        .Type = xlConditionValueNumber
        .Value = 7
        .Operator = 7
    End With
End With

the system keep hightlighing this line. I do not understand what mistake i made. Error 9. the subscript out of range

With Cells(r, l).FormatConditions(1)

 

[ww4612]

in case you want to see the complete code. here is it

Sub shape()
ThisWorkbook.Sheets("score").Activate
ActiveSheet.DrawingObjects.Delete
For l = 2 To 8
For r = 2 To Application.WorksheetFunction.CountIf(Range(Cells(1, 1), Cells(Rows.count, 1)), "*")
If Cells(r, l).Value < 4 And Cells(r, l).Value >= 0 Then
    With Cells(r, l)
    .Font.Size = 11
    .Font.Name = "Arial"
    .Font.Color = RGB(255, 0, 0)
    .Font.Bold = True
    .HorizontalAlignment = xlLeft
    .VerticalAlignment = xlTop
    End With
End If
If Cells(r, l).Value >= 4 And Cells(r, l).Value < 7 Then
    With Cells(r, l)
    .Font.Size = 11
    .Font.Name = "Arial"
    .Font.Color = RGB(255, 165, 0)
    .Font.Bold = True
    .HorizontalAlignment = xlLeft
    .VerticalAlignment = xlTop
    End With
End If
If Cells(r, l).Value >= 7 And Cells(r, l).Value <= 10 Then
    With Cells(r, l)
    .Font.Size = 11
    .Font.Name = "Arial"
    .Font.Color = RGB(0, 128, 0)
    .Font.Bold = True
    .HorizontalAlignment = xlLeft
    .VerticalAlignment = xlTop
    End With
End If
With Range(r, l).FormatConditions(1)
    .ReverseOrder = False
    .ShowIconOnly = False
    .IconSet = ActiveWorkbook.IconSets(xl3TrafficLights1)
    With .IconCriteria(2)
        .Type = xlConditionValueNumber
        .Value = 4
        .Operator = 7
    End With
    With .IconCriteria(3)
        .Type = xlConditionValueNumber
        .Value = 7
        .Operator = 7
    End With
End With
Next r
Next l
End Sub

 

[ww4612]

nevermind, i just find the error.
i missed the line
Cells(r, l) .FormatConditions.AddIconSetCondition
Cells(r, l) .FormatConditions(Selection.FormatConditions.count).SetFirstPriority