ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Adding cells with the same color, sub works but function doesnt (https://www.excelbanter.com/excel-discussion-misc-queries/83737-adding-cells-same-color-sub-works-but-function-doesnt.html)

jerredjohnson

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

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


--
jerredjohnson
------------------------------------------------------------------------
jerredjohnson's Profile: http://www.excelforum.com/member.php...o&userid=32236
View this thread: http://www.excelforum.com/showthread...hreadid=533750


mrice

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

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


--
mrice


------------------------------------------------------------------------
mrice's Profile: http://www.excelforum.com/member.php...o&userid=10931
View this thread: http://www.excelforum.com/showthread...hreadid=533750



All times are GMT +1. The time now is 10:33 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com