Sum or count cells where the background color matches a color in a range of cells

[lmoseley7]

I'm using an updated version of a UDF I found years ago on Ozgrid's website and I've seen many versions of this over the years and through many searches. The UDF allows you to sum or count cells where the background color matched a reference cell's color. A few years ago I updated the code to use .Color instead of .ColorIndex so that it would work with the newer Excel color palettes.

Function ColorFunction2(rColor As Range, rRange As Range, Optional SUM As Boolean)    Dim rCell As Range
    Dim lcol As Long
    Dim vResult


    lcol = rColor.Interior.Color


    If SUM = True Then
        For Each rCell In rRange
            If rCell.Interior.Color = lcol Then
                vResult = WorksheetFunction.SUM(rCell, vResult)
            End If
        Next rCell
    Else
        For Each rCell In rRange
            If rCell.Interior.Color = lcol Then
                vResult = 1 + vResult
            End If
        Next rCell
    End If


   ColorFunction2 = vResult
End Function

What I would like to do now is have it sum or count if the cell's color matches the colors in a range of cells. Like a 'colored cell subtotal'. I adjusted to UDF to look at cells that did not match a certain cell's background color and I had it point to a cell with no background color and it worked, but unfortunately I also used a gray color in a blank column as a visual separator, so it was counting that column as well. Is it possible to loop through a range of cells and have them each tested against a separate range of cells?

 

[Jerry Sullivan]

Hi lmoseley7,

I'm not completely following what you are trying to do.

It sounds like you want the rColor argument to reference multiple cells instead of one, and that those cells might be different colors. If so, are you wanting to Count/Sum the cells in rRange that match any one of the colors in rColor, or something else?

 

[kvsrinivasamurthy]

I am not clear what you want.
This function Counts the Total number of cells in rRange, having same interior colour in rColour range

Function ColorFunction2(rColor As Range, rRange As Range, Optional SUM As Boolean)    Dim rCell As Range, cel As Range
    'Dim lcol As Long
    Dim vResult


 If SUM = True Then
    For Each cel In rColor
        For Each rCell In rRange
            If rCell.Interior.Color = cel.Interior.Color Then
                vResult = 1 + vResult
            End If
        Next rCell
    Next cel
        
 End If
 
 ColorFunction2 = vResult
End Function

 

[lmoseley7]

Hi lmoseley7,

I'm not completely following what you are trying to do.

It sounds like you want the rColor argument to reference multiple cells instead of one, and that those cells might be different colors. If so, are you wanting to Count/Sum the cells in rRange that match any one of the colors in rColor, or something else?

Yes exactly. I want to count or sum the number of cells that are highlighted a color that exists within a range of cells. That way, any other colors that it might come across would be excluded from the calculation.

 

[lmoseley7]

I am not clear what you want.
This function Counts the Total number of cells in rRange, having same interior colour in rColour range

Function ColorFunction2(rColor As Range, rRange As Range, Optional SUM As Boolean)    Dim rCell As Range, cel As Range
    'Dim lcol As Long
    Dim vResult


 If SUM = True Then
    For Each cel In rColor
        For Each rCell In rRange
            If rCell.Interior.Color = cel.Interior.Color Then
                vResult = 1 + vResult
            End If
        Next rCell
    Next cel
        
 End If
 
 ColorFunction2 = vResult
End Function

Wow! for not being clear on what I wanted, you nailed it. I haven't tried this yet but it looks like exactly what I was trying to accomplish, down to the embedded for each statement. I even wanted to ask about an embedded for each statement in the OP, but I didn't want to taint the responses by trying to answer my own question.

 

[lmoseley7]

I am not clear what you want.
This function Counts the Total number of cells in rRange, having same interior colour in rColour range

Function ColorFunction2(rColor As Range, rRange As Range, Optional SUM As Boolean)    Dim rCell As Range, cel As Range
    'Dim lcol As Long
    Dim vResult


 If SUM = True Then
    For Each cel In rColor
        For Each rCell In rRange
            If rCell.Interior.Color = cel.Interior.Color Then
                vResult = 1 + vResult
            End If
        Next rCell
    Next cel
        
 End If
 
 ColorFunction2 = vResult
End Function

Thanks again kvsrinivasamurthy for your help. I had to make a few adjustments to the code. First of all, what you provided counted the cells correctly, but did not sum them. I went back to my previous code and following your example came up with the following, which works great to sum or count. Thanks again and great job reading my mind.

Function ColorFunction4(rColor As Range, rRange As Range, Optional SUM As Boolean)
Dim rCell As Range, cel As Range
    'Dim lcol As Long
    Dim vResult

 If SUM = False Then
    For Each cel In rColor
        For Each rCell In rRange
            If rCell.Interior.Color = cel.Interior.Color Then
                vResult = 1 + vResult
            End If
        Next rCell
    Next cel
 Else
    For Each cel In rColor
        For Each rCell In rRange
            If rCell.Interior.Color = cel.Interior.Color Then
                vResult = WorksheetFunction.SUM(rCell, vResult)
            End If
        Next rCell
    Next cel
 End If
 
 ColorFunction4 = vResult
End Function

 

[kvsrinivasamurthy]

Thanks for the compliment

 

[Jerry Sullivan]

Thanks again kvsrinivasamurthy for your help. I had to make a few adjustments to the code. First of all, what you provided counted the cells correctly, but did not sum them. I went back to my previous code and following your example came up with the following, which works great to sum or count. Thanks again and great job reading my mind.

Function ColorFunction4(rColor As Range, rRange As Range, Optional SUM As Boolean)
Dim rCell As Range, cel As Range
    'Dim lcol As Long
    Dim vResult

 If SUM = False Then
    For Each cel In rColor
        For Each rCell In rRange
            If rCell.Interior.Color = cel.Interior.Color Then
                vResult = 1 + vResult
            End If
        Next rCell
    Next cel
 Else
    For Each cel In rColor
        For Each rCell In rRange
            If rCell.Interior.Color = cel.Interior.Color Then
                vResult = WorksheetFunction.SUM(rCell, vResult)
            End If
        Next rCell
    Next cel
 End If
 
 ColorFunction4 = vResult
End Function

I'd suggest exiting the For Next loop as soon as a match is found. It will be faster, and more importantly, if the rColor has more than one cell with the same color, you wouldn't want the sum/count to be duplicated.

Function ColorFunction4(rColor As Range, rRange As Range, Optional SUM As Boolean)
Dim rCell As Range, cel As Range
    'Dim lcol As Long
    Dim vResult

 If SUM = False Then
    For Each cel In rColor
        For Each rCell In rRange
            If rCell.Interior.Color = cel.Interior.Color Then
                vResult = 1 + vResult
[COLOR="#0000CD"]                Exit For[/COLOR]
            End If
        Next rCell
    Next cel
 Else
    For Each cel In rColor
        For Each rCell In rRange
            If rCell.Interior.Color = cel.Interior.Color Then
                vResult = WorksheetFunction.SUM(rCell, vResult)
[COLOR="#0000CD"]                Exit For[/COLOR]
            End If
        Next rCell
    Next cel
 End If
 
 ColorFunction4 = vResult
End Function

 

[lmoseley7]

I'd suggest exiting the For Next loop as soon as a match is found. It will be faster, and more importantly, if the rColor has more than one cell with the same color, you wouldn't want the sum/count to be duplicated.

Function ColorFunction4(rColor As Range, rRange As Range, Optional SUM As Boolean)
Dim rCell As Range, cel As Range
    'Dim lcol As Long
    Dim vResult

 If SUM = False Then
    For Each cel In rColor
        For Each rCell In rRange
            If rCell.Interior.Color = cel.Interior.Color Then
                vResult = 1 + vResult
[COLOR=#0000cd]                Exit For[/COLOR]
            End If
        Next rCell
    Next cel
 Else
    For Each cel In rColor
        For Each rCell In rRange
            If rCell.Interior.Color = cel.Interior.Color Then
                vResult = WorksheetFunction.SUM(rCell, vResult)
[COLOR=#0000cd]                Exit For[/COLOR]
            End If
        Next rCell
    Next cel
 End If
 
 ColorFunction4 = vResult
End Function

That's an interesting addition. In my example, I need it to find all the matches across several colors and count how many matches it finds. My rColor range would never have duplicates, it's just representative of all the colors included in the table. I tested your adjustments and it counted the number of colors in rColor that had a match, which could be useful in other applications. I can't say I've come across Exit For before. I try to stay away from loops as much as possible, but thanks for the input and the education.

 

[kvsrinivasamurthy]

Replace this line in the code for getting SUM

vResult = 1 + vResult

as

 vResult = rcell.value + vResult