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!

[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!