Help with using a UDF as the criteria for a countif formula

[howar80403]

I have the following VBA code:


Function ConditionalColor(rg As Range, FormatType As String) As Long
'Returns the color index (either font or interior) of the first cell in range rg. If no _
conditional format conditions apply, Then returns the regular color of the cell. _
FormatType Is either "Font" Or "Interior"
Dim cel As Range
Dim tmp As Variant
Dim boo As Boolean
Dim frmla As String, frmlaR1C1 As String, frmlaA1 As String
Dim i As Long

'Application.Volatile 'This statement required if Conditional Formatting for rg is determined by the _
value of other cells

Set cel = rg.Cells(1, 1)
Select Case Left(LCase(FormatType), 1)
Case "f" 'Font color
ConditionalColor = cel.Font.ColorIndex
Case Else 'Interior or highlight color
ConditionalColor = cel.Interior.ColorIndex
End Select

If cel.FormatConditions.Count > 0 Then
'On Error Resume Next
With cel.FormatConditions
For i = 1 To .Count 'Loop through the three possible format conditions for each cell
frmla = .Item(i).Formula1
If Left(frmla, 1) = "=" Then 'If "Formula Is", then evaluate if it is True
'Conditional Formatting is interpreted relative to the active cell. _
This cause the wrong results If the formula isn 't restated relative to the cell containing the _
Conditional Formatting--hence the workaround using ConvertFormula twice In a row. _
If the Function were Not called using a worksheet formula, you could just activate the cell instead.
frmlaR1C1 = Application.ConvertFormula(frmla, xlA1, xlR1C1, , ActiveCell)
frmlaA1 = Application.ConvertFormula(frmlaR1C1, xlR1C1, xlA1, xlAbsolute, cel)
boo = Application.Evaluate(frmlaA1)
Else 'If "Value Is", then identify the type of comparison operator and build comparison formula
Select Case .Item(i).Operator
Case xlEqual ' = x
frmla = cel & "=" & .Item(i).Formula1
Case xlNotEqual ' <> x
frmla = cel & "<>" & .Item(i).Formula1
Case xlBetween 'x <= cel <= y
frmla = "AND(" & .Item(i).Formula1 & "<=" & cel & "," & cel & "<=" & .Item(i).Formula2 & ")"
Case xlNotBetween 'x > cel or cel > y
frmla = "OR(" & .Item(i).Formula1 & ">" & cel & "," & cel & ">" & .Item(i).Formula2 & ")"
Case xlLess ' < x
frmla = cel & "<" & .Item(i).Formula1
Case xlLessEqual ' <= x
frmla = cel & "<=" & .Item(i).Formula1
Case xlGreater ' > x
frmla = cel & ">" & .Item(i).Formula1
Case xlGreaterEqual ' >= x
frmla = cel & ">=" & .Item(i).Formula1
End Select
boo = Application.Evaluate(frmla) 'Evaluate the "Value Is" comparison formula
End If

If boo Then 'If this Format Condition is satisfied
On Error Resume Next
Select Case Left(LCase(FormatType), 1)
Case "f" 'Font color
tmp = .Item(i).Font.ColorIndex
Case Else 'Interior or highlight color
tmp = .Item(i).Interior.ColorIndex
End Select
If Err = 0 Then ConditionalColor = tmp
Err.Clear
On Error GoTo 0
Exit For 'Since Format Condition is satisfied, exit the inner loop
End If
Next i
End With
End If

End Function


The function returns an Index Value corresponding to the background color or conditional formatting of a cell. For example: If the background/conditional formatting color is Red, the Index Value is 3. What I want to do is use this function as part of a Countif formula to count the number of Red cells in an array, something like this: =countif(A1:A2,ConditionalColor(A1,"interior")=3). Suggestions?

[Kenneth Hobs]

Welcome to the forum! When pasting code, please do so between code tags. Insert the tags by typing them or clicking the # icon on the toolbar.

Of course with code from this site like a kb article, you can just paste the link rather than the code or parts of it. Since you have less than 5 posts, you are limited on posted links. You could have said, with code from KB article 190...

Conditional formats can be an issue as are interior color routines in general. You need to do lots of testing so that you understand how that type of routine "works" or doesn't. Chip Pearson has some routines. For color issues like this, you might want to use his Worksheet Selection event to make some updates. http://www.cpearson.com/Excel/colors.aspx

I am not a big fan of ColorIndex. I prefer the Color property myself.


Sub Main()
MsgBox CountIcolors([A1:A10], 3)
End Sub


'=counticolors(A1:A10,3)
Function CountIcolors(aRange As Range, iIndex As Long) As Long
Dim c As Range, x As Long
Application.Volatile
x = 0
For Each c In aRange
If ConditionalColor(c, "Interior") = iIndex Then x = x + 1
Next c
CountIcolors = x
End Function


'http://www.vbaexpress.com/kb/getarticle.php?kb_id=190