Count all colors in a range

**NotQuiteThere** · 05-06-2013, 01:42 PM

This is new to me and I am losing my mind with counting colors. I can count one color in a range. I would like to be able to count all the colors (in cells) in a specified range. VBA is new to me and I have exhausted myself (even with the excellent examples provided) trying to figure out how to count multiple colors in a single row (or range)
I have attached my spreadsheet to make it easier and I am using the UDF colorfunction... am I on the right track? Is this an easy solution?

Please help.KAP Sawmill Working at Height Improvement Schedule.xlsm

**AndyLitch** · 05-06-2013, 01:59 PM

I had a few problems getting the function to work properly so i adjusted it

Function ColorFunction(rColor As Range, rRange As Range)
    Dim rCell As Range
    Dim lCol As Long
    Dim vResult
     
     ''''''''''''''''''''''''''''''''''''''
     'Written by Ozgrid Business Applications
     'www.ozgrid.com
     
     'Sums or counts cells based on a specified fill color.
     '''''''''''''''''''''''''''''''''''''''
     
    lCol = rColor.Interior.ColorIndex
     
        For Each rCell In rRange
            If rCell.Interior.ColorIndex = lCol Then
                vResult = vResult + 1
            End If
        Next rCell
     
    ColorFunction = vResult
End Function

**NotQuiteThere** · 05-06-2013, 02:09 PM

Thank you Andy, I had no problem getting the function to work with one color, and I see in the code that this is for a specified color. BUT what if I want to count for multiple colors? Is it a different piece of code? I know next to nothing about VBA and appreciate any and all help.
Can this function be written as a nested formula? And if so what would the syntax look like?

**Leith Ross** · 05-06-2013, 02:11 PM

Hello NotQuiteThere,

This UDF will count all colored cells in a the specified range. Also, you don't need to use F( to recalculate if a value cells is changed.

Function ColoredCellCount(ByRef Rng As Range) As Long

    Dim Cell As Range
    Dim cntColor As Long
    
    Application.Volatile
    
        For Each Cell In Rng
            If Cell.Interior.ColorIndex <> xlColorIndexNone Then
                cntColor = cntColor + 1
            End If
        Next Cell
        
        ColoredCellCount = cntColor
        
End Function

**NotQuiteThere** · 05-06-2013, 02:33 PM

Thank you, from what I can see that has met my needs. I will confirm the solution and then figure out how to mark the thread solved.

** I have had an opportunity to check the function against my data and it works like a charm. Thank you for marking the post solved and thank you very much for such a quick and accurate solution Leith. **