A macro that counts cells when the conditional formatting formula =True. i.e. the cell is colored ot

[R Tanner]

I have a macro I got from someone that counts colored cells.
Unfortunately, it doesn't work with conditional formatting. Does
anyone know how to solve this so that I can run a macro that would
include conditional formatting? I am trying to determine the number
of cells in a row where the conditional formatting formula equals
true.

'---------------------------------------------------------------------
Function ColorIndex(rng As Integer, _
Optional text As Boolean = True)
'---------------------------------------------------------------------
Dim cell As Range, row As Range
Dim i As Long, j As Long
Dim iWhite As Long, iBlack As Long
Dim aryColours As Variant

If rng.Areas.Count > 1 Then
ColorIndex = CVErr(xlErrValue)
Exit Function
End If

iWhite = WhiteColorindex(rng.Worksheet.Parent)
iBlack = BlackColorindex(rng.Worksheet.Parent)

If rng.Cells.Count = 1 Then
If text Then
aryColours = DecodeColorIndex(rng, True, iBlack)
Else
aryColours = DecodeColorIndex(rng, False, iWhite)
End If

Else
aryColours = rng.Value
i = 0

For Each row In rng.Rows
i = i + 1
j = 0

For Each cell In row.Cells
j = j + 1

If text Then
aryColours(i, j) = _
DecodeColorIndex(cell, True, iBlack)
Else
aryColours(i, j) = _
DecodeColorIndex(cell, False, iWhite)
End If

Next cell

Next row

End If

ColorIndex = aryColours

End Function

'---------------------------------------------------------------------
Private Function WhiteColorindex(oWB As Workbook)
'---------------------------------------------------------------------
Dim iPalette As Long
WhiteColorindex = 0
For iPalette = 1 To 56
If oWB.Colors(iPalette) = &HFFFFFF Then
WhiteColorindex = iPalette
Exit Function
End If
Next iPalette
End Function

'---------------------------------------------------------------------
Private Function BlackColorindex(oWB As Workbook)
'---------------------------------------------------------------------
Dim iPalette As Long
BlackColorindex = 0
For iPalette = 1 To 56
If oWB.Colors(iPalette) = &H0 Then
BlackColorindex = iPalette
Exit Function
End If
Next iPalette
End Function

'---------------------------------------------------------------------
Private Function DecodeColorIndex(rng As Range, _
text As Boolean, _
idx As Long)
'---------------------------------------------------------------------
Dim iColor As Long
If text Then
iColor = rng.Font.ColorIndex
Else
iColor = rng.Interior.ColorIndex
End If
If iColor < 0 Then
iColor = idx
End If
DecodeColorIndex = iColor
End Function

Any help would be appreciated..

 

[Mike H]

Hi,

have a look here but to quote the author, 'It's surprisingly difficult'

http://www.xldynamic.com/source/xld.CFConditions.html


Mike

 

[JLGWhiz]

One thing that I found in checking FormatConditions(1).Interior.ColorIndex is
that if will give you a true reading if the condition is set, but it does not
guarantee that the condition has been met with the color displayed. It only
tells you that the condition is set and the color it is set for. Maybe
someone knows a way around that quirk.

 

[Bob Phillips]

If you follow that link that Mike H gave, you will see how.

 

[JLGWhiz]

Hi Bob, you worked up some good code there, but it seems like a lot of extra
work when checking the cell values could provide the same results in most
cases. If the interior turns red for the value of 5, then check for the
value of 5 in the cell and consider it as a red cell. Maybe I am over
simplifying, but then I have never needed to get into it that deep.

 

[Bob Phillips]

You are correct of course, but the code is a one off that works in all
cases. If you have many different CFs with different conditions, you have to
replicate them all, and if they change ... The code is a workable solution
if it helps, and of course it is done, it is just a cut and paste.