Progressive Status Indicators in Excel

This is one of those posts that is really only for my own benefit. I recently decided to tackle the idea of rather than just putting red, yellow, and green indicator lights on a spreadsheet to indicate how close we were to meeting budget in certain areas, I would programatically allow Excel to determine how “green” or how “red” we were, with yellow in the middle.

So, in other words, if red is RGB(250,0,0), yellow is RGB(250,250,0), and green is RGB(0,250,0), how do we gradually go from red to green depending on how far away from budget we are? By the way, for those who don’t know, the RGB number format is simply three numbers from 0 to 250 that represent how much of each color red, green, and blue the computer ought to use to compose a color. Adding red light to green light makes yellow light, so RGB(250,250,0) means you want to use pure red and pure green, but no blue in order to get yellow.

My first task was deciding how to measure the distance from budget. After a lot of calculations, I realized it should simply be how far from 100% of the budget we were. That leaves a scale of 0 to 100. At 100, we want to just display green, and at 0 we want red.

My second task was fading from red to green by going through yellow. My best solution was to split the task in half. If the actual value was less than 50% of the goal, we would worry about fading from red to yellow (we would only need to mess with the green color). If the actual value was more than 50%, we would fade from yellow to green (only mess with the red color). In other words: If 50% of budget, green = 250, red = calculated value. Blue is always 0.

Since there are 250 steps of color in the RGB scale, but only 125 for each half (red to yellow, yellow to green), then for every percent of budget, we want to add or remove 5 steps of color.

That’s all I need to explain, I think, in order to remember this later. If you have any questions, I will gladly answer them. What follows are two real-world examples taken straight from my current project.

Sub looper()

    Dim mydiff As Double
    Dim i As Integer

    For i = 5 To 10
        mydiff = (Cells(i, 23) - Cells(i, 24)) / Cells(i, 24)
        Call update_indicator("shp" & i - 4, mydiff)
    Next i

End Sub

Sub update_indicator(strShape As String, dblVar As Double)

    Dim intR As Integer
    Dim intG As Integer
    Dim intB As Integer

    intB = 0

    If dblVar < -0.5 Then
        intR = 250
        intG = 250 - (((Abs(dblVar) * 100) - 50) * 5)
    ElseIf dblVar < 0 Then
        intG = 250
        intR = 0 + ((Abs(dblVar) * 100) * 5)
    Else
        intG = 250
        intR = 0
    End If

    ActiveSheet.Shapes(strShape).Select
    Selection.ShapeRange.Fill.ForeColor.RGB = RGB(intR, intG, intB)

End Sub