Mike said:
Hi
I have twelve columns (months)of sales data (percentages calculated from
another sheet) that are conditionally formatted to highlight the highest
and lowest percentages each month (Two cells highlighted each month).
What I want to do is create two columns at the end to count the number
of times the subject has been the highest in the preceding twelve months
and the lowest in the preceding twelve months. I need to count the
number of highlighted cells.
I have tried several formulations but have got nowhere. I will be
grateful if anyone could help.
Regards
Mike
Mike
This is an answer to the problem that was posted to this side a few years
ago. Bob Phillips and Harlan Grove developed the procedure and was posted by
Frank Kabel
Copy the procedure below and paste it into a module of the spreadsheet.
Then use the second Sumproduct formula to find the number for the color
index. Once the color is found then use the first sumproduct formula to
count the cells with that color.
=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
CREATING A FUNCTION TO USE IN CALUCLATIONS
To get the color index of a specific cell use =ColorIndex(A1)
------
'Code to paste in one of your modules
'---------------------------------------------------------------------
Function ColorIndex(rng As range, Optional text As Boolean = False) As Variant
'---------------------------------------------------------------------
' Function: Returns the color index 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
Charlie
