Using Font Color to Determine Count Criteria

[Hornet2433]

Hello,

I am guessing that I am making this process much harder than it really is, so I am asking for help from the experts...

I want to be able to count all of the cells in column A that are red, orange, and black and have the total for each show up in another cell. ie..

Red = 3 Orange = 2 Black = 3
sample1
sample2
sample3
sample4
sample5
sample6
sample7
sample8

Can anyone help with this macro?

Thanks,
Hornet2433

 

[SkipVought]

hi,

1. enter this code

Function WhatInteriorColor(rng as Range) as Long
   WhatInteriorColor = rng.Interior.Color
End Function

2. in an adjacent column enter

=WhatInteriorColor(A1)

and copy down and

Then do a PivotTable on the results (you will need a column heading) and COUNT the occurences

VOLA!

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[Bowers74]

Hi Hornet,

You could also try the following functions to count (or sum) the cells that have a certain font color. With a slight modification, you can count or sum by background color:

Function CountByColor(InputRange As Range, ColorRange As Range) As Long
' returns the number of cells in the range InputRange that have the same
' background or font (uncomment correct lines) color as the cell in ColorRange
' example: =CountByColor($A$1:$A$20,B1)
' range A1:A20 is the range you want to sum
' range B1 is a cell with the background color you want to sum
Dim cl As Range, TempCount As Long, ColorIndex As Integer
Application.Volatile
    ' ColorIndex = ColorRange.Cells(1, 1).Interior.ColorIndex ' Background Color
    ColorIndex = ColorRange.Cells(1, 1).Font.ColorIndex ' Font Color
    TempCount = 0
    For Each cl In InputRange.Cells
        'If cl.Interior.ColorIndex = ColorIndex Then ' This is for Background Color
        If cl.Font.ColorIndex = ColorIndex Then 'This is for Font Color
            TempCount = TempCount + 1
        End If
    Next cl
    Set cl = Nothing
    CountByColor = TempCount
End Function

Function SumByColor(InputRange As Range, ColorRange As Range) As Double
' returns the sum of each cell in the range InputRange that has the same
' background or font (uncomment correct lines) color as the cell in ColorRange
' example: =SumByColor($A$1:$A$20,B1)
' range A1:A20 is the range you want to sum
' range B1 is a cell with the background color you want to sum
Dim cl As Range, TempSum As Double, ColorIndex As Integer
Application.Volatile
    ' ColorIndex = ColorRange.Cells(1, 1).Interior.ColorIndex ' Background Color
    ColorIndex = ColorRange.Cells(1, 1).Font.ColorIndex ' Font Color
    TempSum = 0
    On Error Resume Next
    For Each cl In InputRange.Cells
        'If cl.Interior.ColorIndex = ColorIndex Then ' This is for Background Color
        If cl.Font.ColorIndex = ColorIndex Then 'This is for Font Color
            TempSum = TempSum + cl.Value
        End If
    Next cl
    On Error GoTo 0
    Set cl = Nothing
    SumByColor = TempSum
End Function

I hope these help!

Peace!

Mike

Never say Never!!!
Nothing is impossible!!!