Conditional Formatting with Colored Icons using VBA

Question

Hi everyone,

I'm trying to implement some VBA code into my project that will display a red or green up/down arrow based on a certain condition.

My table looks like this:

Store	Year	A Values	B Values	C Values	D Values
1	2015	0.0	0.0	1.8	2.6
1	2016	1.2	0.0	2.2	1.1

My current VBA does the following:

• If the Store Number in column 1 matches, the value in columns 3-6 get compared. If the values in 2016 are greater/less than 2015, 2016's cell gets formatted by coloring the cell red or green. My current code is this:

Sub ColorYear()

Dim long1 As Long

Dim rng As Range

Set rng = ActiveSheet.Range("A:A")

long1 = Application.WorksheetFunction.CountA(rng)

For t = 2 To long1

If ActiveSheet.Range("A" & t).Value = ActiveSheet.Range("A" & t - 1).Value Then

    If ActiveSheet.Range("C" & t).Value < ActiveSheet.Range("C" & t - 1).Value Then

    ActiveSheet.Range("C" & t).Interior.Color = RGB(0, 255, 0)

    ElseIf ActiveSheet.Range("C" & t).Value > ActiveSheet.Range("C" & t - 1).Value Then

    ActiveSheet.Range("C" & t).Interior.Color = RGB(255, 0, 0)

    End If

    If ActiveSheet.Range("D" & t).Value < ActiveSheet.Range("D" & t - 1).Value Then

    ActiveSheet.Range("D" & t).Interior.Color = RGB(0, 255, 0)

    ElseIf ActiveSheet.Range("D" & t).Value > ActiveSheet.Range("D" & t - 1).Value Then

    ActiveSheet.Range("D" & t).Interior.Color = RGB(255, 0, 0)

    End If

    If ActiveSheet.Range("E" & t).Value < ActiveSheet.Range("E" & t - 1).Value Then

    ActiveSheet.Range("E" & t).Interior.Color = RGB(0, 255, 0)

    ElseIf ActiveSheet.Range("E" & t).Value > ActiveSheet.Range("E" & t - 1).Value Then

    ActiveSheet.Range("E" & t).Interior.Color = RGB(255, 0, 0)

    End If

    If ActiveSheet.Range("F" & t).Value < ActiveSheet.Range("F" & t - 1).Value Then

    ActiveSheet.Range("F" & t).Interior.Color = RGB(0, 255, 0)

    ElseIf ActiveSheet.Range("F" & t).Value > ActiveSheet.Range("F" & t - 1).Value Then

    ActiveSheet.Range("F" & t).Interior.Color = RGB(255, 0, 0)

    End If

End If

Next t

End Sub

What I'd like to do is instead of just coloring the cell red/green, I'd like to implement the colored up/down arrow icons. I have no idea how to write this out though, so I was hoping for some assistance.

Answer 1

Like this:

Sub ColorYear()

    Dim long1 As Long

    Dim t As Long

    Dim c As Long

    Application.ScreenUpdating = False

    ' Last used row

    long1 = Cells(Rows.Count, 1).End(xlUp).Row

    ' Delete existing rules

    Range("B3:I" & long1).FormatConditions.Delete

    ' Loop through the rows

    For t = 3 To long1

        For c = 3 To 9 Step 2 ' columns C,E,G,I

            With Cells(t, c).FormatConditions.AddIconSetCondition

                .IconSet = ActiveWorkbook.IconSets(xl3Arrows)

                With .IconCriteria(2)

                    .Type = xlConditionValueFormula

                    .Value = "=" & Cells(t, c - 1).Address

                    .Operator = 7

                End With

                With .IconCriteria(3)

                    .Type = xlConditionValueFormula

                    .Value = "=" & Cells(t, c - 1).Address

                    .Operator = 5

                End With

            End With

        Next c

    Next t

    Application.ScreenUpdating = True

End Sub

Answer 2

Try this:

Sub ColorYear()

    Dim long1 As Long

    Dim t As Long

    Dim c As Long

    Application.ScreenUpdating = False

    ' Last used row

    long1 = Application.WorksheetFunction.CountA(Range("A:A"))

    ' Delete existing rules

    Range("C2:F" & long1).FormatConditions.Delete

    ' Loop through the rows

    For t = 2 To long1

        If Cells(t - 1, 1).Value = Cells(t, 1).Value Then

            For c = 3 To 6 ' columns C to F

                With Cells(t, c).FormatConditions.AddIconSetCondition

                    .IconSet = ActiveWorkbook.IconSets(xl3Arrows)

                    With .IconCriteria(2)

                        .Type = xlConditionValueFormula

                        .Value = "=" & Cells(t - 1, c).Address

                        .Operator = 7

                    End With

                    With .IconCriteria(3)

                        .Type = xlConditionValueFormula

                        .Value = "=" & Cells(t - 1, c).Address

                        .Operator = 5

                    End With

                End With

            Next c

        End If

    Next t

    Application.ScreenUpdating = True

End Sub

Answer 3

No worries, I just reversed the icon order which seems to serve my purposes.

Thank you again Hans!!

Answer 4

Sorry, no. The icon sets are fixed, and the red arrow is always down and the green one is up.

Answer 5

Thank you Hans!!! This is just about perfect.

Is it possible to change the colors of the arrows? For instance, instead of a red down arrow, switch it to a green down arrow and red up arrow?