SUM by colour

[Mat2020]

Hi all,

I have a code that sums the values of cells with the same colour in a range of excel cells, and it works nicely... well, almost.

It works nicely if there are only numbers in the range of cells. If I add text in any of them, I get #VALUE!

How do I change the code so it ignores the text and only sums the numbers?

Code below:



Option Explicit



Function ColorMath(InputRange As Range, ReferenceCell As Range, Optional Action As String = "S")

Application.Volatile

' Action can be S to SUM, A to AVERAGE, or C to COUNT
' If not specified the default Action is SUM

Dim ReferenceColor As Long
Dim CellCount As Long
Dim Result As Variant
Dim Cell As Range

Action = UCase(Action)
Result = 0
CellCount = 0
ReferenceColor = ReferenceCell.Interior.Color

If Action = "S" Or Action = "A" Then

For Each Cell In InputRange

If Cell.Interior.Color = ReferenceColor Then

Result = Result + Cell.Value
CellCount = CellCount + 1

End If

Next Cell

End If

If Action = "C" Then

For Each Cell In InputRange

If Cell.Interior.Color = ReferenceColor Then Result = Result + 1

Next Cell

End If

If Action = "A" Then

Result = Result / CellCount

End If


ColorMath = Result


End Function

[SamT]

Add an If Then test

If IsNumeric(Cell) Then
Additions
End If

BTW, what is CellCount Used for?

[Mat2020]

Thanks SamT,

I added 'if' as you suggested, but it comes up with an error, highlighting 'Additions'...

CellCount is for counting the number of cells. I think :) I just grabbed the code from somewhere.

I also have another version of the code that sums the values in the range of cells successfully, even if there is text in some of them. But that code doesn't seem to differentiate between cell colours that are similar. Is there a way for a code to look for the exact colour code? So that even two colours that are very similar are determined as different colours?

The code below:


Function SumByColor(CellColor As Range, rRange As Range)Dim cSum As Long
Dim ColIndex As Integer
ColIndex = CellColor.Interior.ColorIndex
For Each cl In rRange
If cl.Interior.ColorIndex = ColIndex Then
cSum = WorksheetFunction.SUM(cl, cSum)
End If
Next cl
SumByColor = cSum
End Function


Thank you!

[Bob Phillips]

Function SumByColor(CellColor As Range, rRange As Range)
Dim cell As Range
Dim cSum As Long
Dim ColIndex As Long

ColIndex = CellColor.Interior.Color
For Each cell In rRange
If cell.Interior.Color = ColIndex Then
cSum = WorksheetFunction.Sum(cell, cSum)
End If
Next cell
SumByColor = cSum
End Function

[Mat2020]

Thank you xld. Much appreciated! That seems to differentiate the colours well! So, it works.

Any way this could be applied to my original code? That one sums the cells and counts the cells, which is what I need. But it doesn't sum, if there is text in any of the cells. Any way you can amend that one?

Many thanks!

[Bob Phillips]

Function ColorMath(InputRange As Range, ReferenceCell As Range, Optional Action As String = "S")

Application.Volatile

' Action can be S to SUM, A to AVERAGE, or C to COUNT
' If not specified the default Action is SUM

Dim ReferenceColor As Long
Dim CellCount As Long
Dim Result As Variant
Dim cell As Range

Action = UCase(Action)
ReferenceColor = ReferenceCell.Interior.Color

If Action = "S" Or Action = "A" Then

For Each cell In InputRange

If cell.Interior.Color = ReferenceColor Then

Result = WorksheetFunction.Sum(cell, Result)
CellCount = CellCount + 1
End If
Next cell
End If

If Action = "C" Then

For Each cell In InputRange

If cell.Interior.Color = ReferenceColor Then Result = Result + 1
Next cell
End If

If Action = "A" Then

Result = Result / CellCount
End If

ColorMath = Result
End Function

[Mat2020]

THANK YOU! This works perfectly! :clap:

[SamT]

Did you find the Keyword "Additions" in any Excel or VBA Help file anywhere? No? Well that's because it isn't. That's where you are supposed to place your adding cell values code.

[Bob Phillips]

BTW, what is CellCount Used for?

To calculate the average.

[SamT]

Thanks. Now I SEE!