Adding cells with the same color, sub works but function doesnt

[jerredjohnson]

I have tried to create an UDF. But I am doing something wrong and I can
not see the problem. The goal of this UDF is to search a range of
cells, find all cells that have a particular color, sum their values
and place the value in the activecell. So what am I doing wrong? I
have calculated the yellow cells 2 ways. The first is the UDF that
doesn't work. And the 2nd is a subroutine that does work. Please look
at the function and tell me what I am missing. Thank you.

Function Color_Sum(ByRef rngCount As Range, ByRef rngStart As Range) As
Single

Dim intColor As Integer
Dim i As Integer
Dim sumColor As Single
Dim intCount As Single

intCount = Range(rngCount).Cells.Count
intColor = ActiveCell.Interior.ColorIndex
Color_Sum = 0

For i = 1 To intCount
If Range(rngStart).Offset(i, 0).Interior.ColorIndex = intColor
Then
Color_Sum = Range(rngStart).Offset(i, 0).Value + Color_Sum
End If
Next i

ActiveCell.Value = Color_Sum

End Function

Sub Color_Sum_2()

Dim intColor As Integer
Dim i As Integer
Dim sumColor As Single
Dim intCount As Single
Dim Color_Sum As Single

intCount = Range("ListA").Cells.Count
intColor = ActiveCell.Interior.ColorIndex
Color_Sum = 0

For i = 1 To intCount
If Range("D8").Offset(i, 0).Interior.ColorIndex = intColor Then
Color_Sum = Range("D8").Offset(i, 0).Value + Color_Sum
End If
Next i

ActiveCell.Value = Color_Sum

End Sub

 

[mrice]

It's not clear why you are using a function as you are aiming to change
the value of a cell. Will the following subroutine work?
Sub Total_Color_Sum(ByRef rngCount As Range)

Dim intColor As Integer
Dim i As Integer
Dim sumColor As Single
Dim intCount As Single
Dim Cell As Range

intColor = ActiveCell.Interior.ColorIndex

For Each Cell In rngCount
If Cell.Interior.ColorIndex = intColor Then
Color_Sum = Cell + Color_Sum
End If
Next Cell

ActiveCell.Value = Color_Sum

End Sub