Fail in formula

[Marcelino]

Hi,

I've search everywhere but i still don't have solve of my problem.

I need a formula, which count cells by colour of text. I found a lot of formulas, but all of them count blank cells too.(there are empty, but formatted)

The formula which I'm using is:

Function CountColor(InRange As Range, ColorIndex As Long, _
    Optional OfText As Boolean = False) As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CountColor
' This function counts the cells in InRange whose ColorIndex
' is equal to the ColorIndex parameter. The ColorIndex of the
' Font is tested if OfText is True, or the Interior property
' if OfText is omitted or False. If ColorIndex is not a valid
' ColorIndex (1 -> 56, xlColorIndexNone, xlColorIndexAutomatic)
' 0 is returned. If ColorIndex is 0, then xlColorIndexNone is
' used if OfText is Fasle or xlColorIndexAutomatic if OfText
' is True. This allows the caller to use a value of 0 to indicate
' no color for either the Interior or the Font.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim r As Range
Dim N As Long
Dim CI As Long

If ColorIndex = 0 Then
    If OfText = False Then
        CI = xlColorIndexNone
    Else
        CI = xlColorIndexAutomatic
    End If
Else
    CI = ColorIndex
End If


Application.Volatile True
Select Case ColorIndex
    Case 0, xlColorIndexNone, xlColorIndexAutomatic
        ' OK
    Case Else
        If IsValidColorIndex(ColorIndex) = False Then
            CountColor = 0
            Exit Function
        End If
End Select

For Each r In InRange.Cells
    If OfText = True Then
        If r.Font.ColorIndex = CI Then
            N = N + 1
        End If
    Else
        If r.Interior.ColorIndex = CI Then
            N = N + 1
        End If
    End If
Next r

CountColor = N

End Function</pre>

Maybe i can use formula counta, but i don't know how.

Please help

 

[VoG]

Try

For Each r In InRange.Cells
    If OfText = True Then
        If r.Font.ColorIndex = CI And r.Value <> "" Then
            N = N + 1
        End If
    Else
        If r.Interior.ColorIndex = CI And r.Value <> "" Then
            N = N + 1
        End If
    End If
Next r

 

[Andrew Poulsom]

Can't you just add a test that the cells aren't empty?

For Each r In InRange.Cells
    If Len(r.Value) > 0 Then
        If OfText = True Then
            If r.Font.ColorIndex = CI Then
                N = N + 1
            End If
        Else
            If r.Interior.ColorIndex = CI Then
                N = N + 1
            End If
        End If
    End If
Next r

 

[Marcelino]

Yeah It works great. My problem is solved. Thank you very much