Count cells which have particular format?

[Frank Kabel]

Hi
you'll need VBA for this. Below a repost (watch the
linebreaks)
------
using a procedure from Bob Phillips and Harlan Grove you
may try the
following:

=SUMPRODUCT(--(ColorIndex(A1:A100)=3))
to count all red cells (background color) within the range
A1:A100

or
=SUMPRODUCT(--(ColorIndex(A1:A100,TRUE)=3))
to count all red cells (font color) within the range
A1:A100

To get the colorindex of a specific cell use
=ColorIndex(A1)

Adapt this to your requirements

------
'Code to paste in one of your modules

'----------------------------------------------------------
-----------
Function ColorIndex(rng As Range, _
Optional text As Boolean = False) As
Variant
'----------------------------------------------------------
-----------
' Function: Returns the colorindex of the supplied
range
' Synopsis:
' Author: Bob Phillips/Harlan Grove
'
'----------------------------------------------------------
-----------
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

 

[Harlan Grove]

...
...

' Author: Bob Phillips/Harlan Grove ...
iWhite = WhiteColorindex(rng.Worksheet.Parent)
iBlack = BlackColorindex(rng.Worksheet.Parent) ...
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

...

Kindly don't associate *MY* name with code so monumentally POINTLESS and *YOUR*
WhileColorindex and BlackColorindex functions. Maybe you had some purpose in
mind when you wrote tham, but as you never use the values assigned to iWhite and
iBlack in your main udf, they're a waste of cycles and storage.

What I actually wrote is in

http://www.google.com/[email protected]

though my preferred approach is to avoid screwing around with multiple special
purpose functions, and instead use a single function to access most range,
worksheet and workbook properties, as in

http://www.google.com/groups?selm=0vb89.20087$Ke2.1629609@bgtnsc04-news.ops.worldnet.att.net

Note: I've since fixed the sign problem I mentioned in that post.

 

[Frank Kabel]

Harlan Grove wrote:
[...]

Kindly don't associate *MY* name with code so monumentally POINTLESS
and *YOUR* WhileColorindex and BlackColorindex functions.

will do