Colours in Excel

[mattygriff]

Hi all,

I have a piece of code based on a couple of examples from TekTips which I am using to count the number of cells in a range which have a particular colour font. The colour of the font is chosen by selecting one of a number of cells with different background colours to match the various font colours used.

Function CountByColour(CountRange As Range, FindColour As Range) As Long
    Dim ColourCount As Long, c As Range
    ColToFind = FindColour.Interior.ColorIndex
        
    Application.Volatile
    For Each c In CountRange
        If c.Font.ColorIndex = ColToFind Then
            ColourCount = ColourCount + 1
        End If
    Next
    CountByColour = ColourCount
    
End Function

All seems to work fine except when I try to count the number of cells containing black font when the function always returns zero although I get the correct answers for red, yellow and so on but not for black.

The problem seems to be connected with the "Automatic" font colour which isn't recognised as being black (although it is set to black in the worksheet) - when I specifically format the automatic cells to black, I get the right answer.

Any ideas how I can force the formula to recognise "Automatically black" font as well as cells where the font has been specifically set to black?

Also, in order to use this formula I have to select it from the Insert -> Formula box - I can't just type it into a cell in the normal way. Any thoughts?

Thanks in advance.

 

[SkipVought]

Hi,

1. Declare ColToFind

2. change to get the FONT colorindex

    ColToFind = FindColour.Interior.ColorIndex

3. for BLACK, add two functions looking for BLACK and AUTOMATIC.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

Hi,

1. Declare ColToFind

2. change to get the FONT colorindex

    ColToFind = FindColour.Font.ColorIndex

3. for BLACK, add two functions looking for BLACK and AUTOMATIC.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[mattygriff]

Thanks Skip.

I tweaked my code as follows (although still checking the fill colour rather than the font colour) and all is working A-OK.

Function CountByColour(CountRange As Range, FindColour As Range) As Long
    Dim ColourCount As Long, c As Range
    ColToFind = FindColour.Interior.ColorIndex
    If ColToFind = 1 Then
        ColToFind2 = -4105
    Else
        ColToFind2 = ColToFind
    End If
    Application.Volatile
    For Each c In CountRange
        If c.Font.ColorIndex = ColToFind Or _
            c.Font.ColorIndex = ColToFind2 Then
            ColourCount = ColourCount + 1
        End If
    Next
    CountByColour = ColourCount
    
End Function