Skip to content

COUNTIF & SUMIF On Colour Using VBA Custom Function

    This video demonstrates how to count and sum based on the background colour of a cell. The solution uses custom VBA functions. Download the featured file here. Please note I cannot upload macro enable files to this website, so you will need to copy the code shown below.

    Here are the custom VBA functions featured in the video:

    Count red cells function

    Function CountRedCells(Rge As Range) As Double
    
    Dim CellInRge As Range
    
    For Each CellInRge In Rge
    
        If CellInRge.Interior.Color = RGB(255, 0, 0) Then
            CountRedCells = CountRedCells + 1
        End If
        
    Next CellInRge
        
    End Function

    Count coloured cells function

    Function CountColouredCells(Rge As Range, Colour As Range) As Double
    
    Dim CellInRge As Range
    
    For Each CellInRge In Rge
    
        If CellInRge.Interior.Color = Colour.Interior.Color Then
            CountColouredCells = CountColouredCells + 1
        End If
        
    Next CellInRge
        
    
    End Function

    Sum red products function

    Function SumRedCells(Rge As Range, SumColPos As Byte) As Currency
    
    Dim CellInRge As Range
    
    For Each CellInRge In Rge
    
        If CellInRge.Interior.Color = RGB(255, 0, 0) Then
            SumRedCells = CellInRge.Offset(0, SumColPos - 1) + SumRedCells
        End If
        
    Next CellInRge
    
    End Function

    Sum coloured cells function

    Function SumColouredCells(Rge As Range, Colour As Range, SumColPos As Byte) As Currency
    
    Dim CellInRge As Range
    
    For Each CellInRge In Rge
    
        If CellInRge.Interior.Color = Colour.Interior.Color Then
            SumColouredCells = CellInRge.Offset(0, SumColPos - 1) + SumColouredCells
        End If
        
    Next CellInRge
    
    End Function

    Code to get the formulas to automatically update when you change cell colour. This needs to be stored in the relevant worksheet object.

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Calculate
    End Sub