VBA Function (UDF) to sum cells that match a color

I'm trying to write a function that will take two arguments (range,cell).  I'd like to sum all of the cells inside the 'range' that match the color inside of 'cell'.  See attached for an idea of what I'm talking about.  Does anyone have a function that does this?
SumByColor.xlsx
BBluAsked:
Who is Participating?
 
kgerbConnect With a Mentor Chief EngineerCommented:
Here's a new one that updates with the worksheet recalc.
Function SumByColor(rng As Range, cll As Range) As Double
Dim r As Range
Application.Volatile
For Each r In rng
    If r.Interior.ColorIndex = cll.Interior.ColorIndex Then SumByColor = SumByColor + r
Next r
End Function

Open in new window

Kyle
0
 
Frank WhiteConnect With a Mentor Commented:
You can use the .Interior.ColorIndex property for this. Something along the lines of:

Function ColorSum(TheRange as Range) As Long
For Each c in TheRange
    If c.Interior.ColorIndex = 6 Then mySum = mySum + c.Value
Next
ColorSum = mySum
End Function

Open in new window


(add definitions and whatever other code is needed, as appropriate and depending on whether you use Option Explicit, which I recommend)

The "= 6" for ColorIndex is the index from the current color palette. I'm sure if you look around, you can find which numbers you'll need for your particular purpose.

EDIT: This link might be helpful in figuring out how to use the ColorIndex property with the above method.
0
 
kgerbChief EngineerCommented:
Here is one where the color index is not static but dependent on the color index of the cell specified in the 2nd argument.
Function SumByColor(rng As Range, cll As Range) As Double
Dim r As Range
For Each r In rng
    If r.Interior.ColorIndex = cll.Interior.ColorIndex Then SumByColor = SumByColor + r
Next r
End Function

Open in new window

Kyle
0
Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

 
Anthony BerenguelCommented:
try this.. although it looks pretty similar to the solution above

Function sumByBGC(r As RANGE, c As String)
    'sum by background color
    Dim result As Long
    result = 0

    Debug.Print c
    For Each cell In r
        Debug.Print cell
        With cell
                If cell.Interior.ColorIndex = RANGE(c).Interior.ColorIndex Then
                result = result + cell.Value
            End If
        End With
    Next
    sumByBGC = result
End Function

Open in new window

0
 
Frank WhiteConnect With a Mentor Commented:
For a (small) speed boost  with Kyle's second function example, add a new variable and set it to cll.Interior.ColorIndex. This will shave off a few VBA-to-Worksheet reads, which can make a difference in performance if you're using this UDF in volatile mode across a lot of cells. Then compare each r against this new variable.
0
 
Zack BarresseCEOCommented:
www.asap-utilities.com has this functionality.

Regards,
Zack Barresse
0
 
BBluAuthor Commented:
Thanks, Guys.  Just what I was looking for.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.