Counting Colors & Cell Contents in a Table

[WildWill]

I have a table of data and from it I can calculate two things SEPERATELY:

1. Count different formatting colours as applied to the cells in the table - this I achieved by getting some custom code (see below) and placing this in a module of the workbook, and then using the formula ColorFunction($ATO$6,$B34:$ATE34) to count total cells contianing a specific color:

Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o> </o>
Dim rCell As Range<o></o>
<o> </o>
Dim lCol As Long<o></o>
<o> </o>
Dim vResult<o></o>
<o> </o><o> </o><o> </o>
''''''''''''''''''''''''''''''''''''''<o></o>
<o> </o>
'Written by Ozgrid Business Applications<o></o>
<o> </o>
'www.ozgrid.com<o></o>

1. Counts cells which contain a specific string of text using the formula: COUNTIF($B34:$ATE34,"*"&$ATU$3&"*"),"")

Now I want to combine these two functions together and count (from the same table) the number of cells which meet BOTH criteria, e.g. where the cell color is (e.g.) Yellow AND where the text string contains "ABC". Is this possible, and how will I achieve that? Thanks!

 

[Phanmore]

I think this should work. (sorry I don't usuallyl right functions, but seems to work!)

Function CountColor(cR As Range, Color As Integer, txt As String)
For Each Cell In cR
If Cell.Interior.ColorIndex = Color And Cell.Value = txt Then CountColor = CountColor + 1
Next Cell
End Function

Just add the formula as follows
CountColor('Your Range','Colour code','your text')
i.e
=countcolor(B2:G6,6,"ABC")

 

[Krishnakumar]

Hi,

Try this UDF

Function COLORCOUNTIFS(ByRef rngRange As Range, ByRef rngColor As Range, _
                        ByVal Criteria, Optional ByVal FontColor As Boolean = False) As Long


Dim ka, i As Long, c As Long, iColor As Long, blnWildCard As Boolean

ka = rngRange
If FontColor Then
    iColor = rngColor.Font.Color
Else
    iColor = rngColor.Interior.Color
End If

If Left$(Criteria, 1) = Chr(42) Then blnWildCard = True
If Right$(Criteria, 1) = Chr(42) Then blnWildCard = True
For i = 1 To UBound(ka, 1)
    For c = 1 To UBound(ka, 2)
        If blnWildCard Then
            If LCase$(ka(i, c)) Like LCase$(Criteria) Then
                GoTo JumpHere
            Else: GoTo Nxt: End If
        Else
            If LCase$(ka(i, c)) = LCase$(Criteria) Then
                GoTo JumpHere
            Else: GoTo Nxt: End If
        End If
JumpHere:
        If FontColor Then
            If rngRange.Cells(i, c).Font.Color = iColor Then
                COLORCOUNTIFS = COLORCOUNTIFS + 1
            End If
        Else
            If rngRange.Cells(i, c).Interior.Color = iColor Then
                COLORCOUNTIFS = COLORCOUNTIFS + 1
            End If
        End If
Nxt:
    Next
Next
    
End Function

use like

=COLORCOUNTIFS($B34:$ATE34,$ATO$6,"*"&$ATU$3&"*")

HTH

 

[WildWill]

Hi Kris

Thanks! Do I simply add the code that you have provided into the module below that other code which already exists to calculate the ColorFunction calculation, or do I replace the entire content of the module with this code of yours?

 

[Krishnakumar]

Hi Kris

Thanks! ......, or do I replace the entire content of the module with this code of yours?

Yes.