Heat Map Using VBA/Conditional Formatting

Question

I'm attempting to create a heat map of "old" inventory. I have created a map of all inventory locations and I'm using conditional formatting to highlight cells containing old inventory on each sheet. There are 7 sheets representing each level of a certain location.

Level 1 Locations:

Level 2 Locations:

I'm going to have a hidden sheet with a count of red cells for each location (Example: Look at cell C4 on all 7 sheets and keep a count of red cells)

I will reference these counts to format a location overview sheet (Green, Yellow, Orange, Red).

I'm using the following VBA code to try and accomplish this:

Function ColorFunction(rColor As Range, rRange As Range, rRange2 As Range, _
        rRange3 As Range, rRange4 As Range, rRange5 As Range, _
        rRange6 As Range, rRange7 As Range, Optional SUM As Boolean)
    Dim rCell As Range
    Dim lCol As Long
    Dim vResult
    lCol = rColor.Interior.ColorIndex
    If SUM = True Then
        For Each rCell In rRange
            If rCell.Interior.ColorIndex = lCol Then
                vResult = WorksheetFunction.SUM(rCell, vResult)
            End If
        Next rCell
    Else
        For Each rCell In rRange
            If rCell.Interior.ColorIndex = lCol Then
                vResult = 1 + vResult
            End If
        Next rCell
        For Each rCell In rRange2
            If rCell.Interior.ColorIndex = lCol Then
                vResult = 1 + vResult
            End If
        Next rCell
        For Each rCell In rRange3
            If rCell.Interior.ColorIndex = lCol Then
                vResult = 1 + vResult
            End If
        Next rCell
        For Each rCell In rRange4
            If rCell.Interior.ColorIndex = lCol Then
                vResult = 1 + vResult
            End If
        Next rCell
        For Each rCell In rRange5
            If rCell.Interior.ColorIndex = lCol Then
                vResult = 1 + vResult
            End If
        Next rCell
        For Each rCell In rRange6
            If rCell.Interior.ColorIndex = lCol Then
                vResult = 1 + vResult
            End If
        Next rCell
        For Each rCell In rRange7
            If rCell.Interior.ColorIndex = lCol Then
                vResult = 1 + vResult
            End If
        Next rCell
    End If
    ColorFunction = vResult
End Function

Reference Sheet 3 Below:

I'm seeing a couple issues, when I apply the same conditional formatting to a cell on the same sheet (A1) and reference that for color my count shows as 7 as though no color is being applied as each of the 7 sheets has "No Fill". If I change the color of any of the C4 cells to anything else (White,Yellow, Purple) the number will drop to 6,5,4....

I manually added a red color in cell A3 and if I manually color one of the C4 cells red, I will get an accurate count.

Sheet 3 (Color Count):

Any suggestions as to how I could fix this? I've already verified the conditional formatting applied to all 7 sheets is using RGB(255,0,0) and the manual red cell is also RGB(255,0,0). I'm at a total loss.

Sorry, caught that myself. I updated the images to show row & column headings. As for the code yea I have little to no experience with VBA but it appears it may work to some extent when I manually fill each cell — arrchar
I cropped you images to include only an example. (See minimal reproducible example). Clicking the images will still open your "fullscreen" version. . . . Can you clarify, do you just need a total number of red cells on the 7 worksheets? If so, there are several examples (like this one) on this site and others,. Also, you could remove more than half of your code by using the Union Function to combine the 7 duplicate If/For statements. — ashleedawg
If you want to check color from Conditional Formatting then you need to use DisplayFormat.Interior.ColorIndex. Your current code will only detect manually-applied color fills. — Tim Williams

Tim Williams Tim Williams · Accepted Answer · 2018-09-30T07:48:41

If you want to check color from Conditional Formatting then you need to use DisplayFormat.Interior.ColorIndex. Your current code will only detect static color fills.

Untested:

Function ColorFunction(rColor As Range, rRange As Range, rRange2 As Range, _
        rRange3 As Range, rRange4 As Range, rRange5 As Range, _
        rRange6 As Range, rRange7 As Range, Optional SUM As Boolean)

    Dim rCell As Range, rng
    Dim lCol As Long
    Dim vResult
    lCol = rColor.Interior.ColorIndex

    If SUM = True Then
        For Each rCell In rRange
            If rCell.DisplayFormat.Interior.ColorIndex = lCol Then
                vResult = vResult + rCell.Value
            End If
        Next rCell
    Else
        For Each rng In Array(rRange, rRange2, rRange3, rRange4, _
                              rRange5, rRange6, rRange7)
            For Each rCell In rng.Cells
                If rCell.DisplayFormat.Interior.ColorIndex = lCol Then
                    vResult = 1 + vResult
                End If
            Next rCell
        Next rng
    End If
    ColorFunction = vResult
End Function

Heat Map Using VBA/Conditional Formatting

1 Answers