Fail in formula

Marcelino

New Member
Joined
Jun 25, 2010
Messages
13
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:

Code:
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

Legend
Joined
Jun 19, 2002
Messages
63,651
Try

Rich (BB code):
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

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Can't you just add a test that the cells aren't empty?

Code:
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
 

Forum statistics

Threads
1,081,749
Messages
5,361,064
Members
400,611
Latest member
ThebigG

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top