Sorry, I deleted the last post because I decided we can have our cake and eat it too! Two out three of these functions are Chip Pearson's, bright guy..
Paste the following functions in a normal vba module:
Function CntCondCol(InputRange As Range, ColorRange As Range) As Double
Dim cl As Range, TempCount As Double, ColorIndex As Integer
Application.Volatile
If ActiveCondition(ColorRange)<> 0 Then
ColorIndex = ColorIndexOfCF(ColorRange)
Else: ColorIndex = ColorRange.Cells(1, 1).Interior.ColorIndex
End If
TempCount = 0
On Error Resume Next
For Each cl In InputRange.Cells
If ColorIndexOfCF(cl) = ColorIndex Then TempCount = TempCount + 1
Next cl
On Error GoTo 0
Set cl = Nothing
CntCondCol = TempCount
End Function
Function ActiveCondition(Rng As Range) As Integer
Dim Ndx As Long
Dim FC As FormatCondition
If Rng.FormatConditions.Count = 0 Then
ActiveCondition = 0
Else
For Ndx = 1 To Rng.FormatConditions.Count
Set FC = Rng.FormatConditions(Ndx)
Select Case FC.Type
Case xlCellValue
Select Case FC.Operator
Case xlBetween
If CDbl(Rng.Value) >= CDbl(FC.Formula1) And _
CDbl(Rng.Value)<= CDbl(FC.Formula2) Then
ActiveCondition = Ndx
Exit Function
End If
Case xlGreater
If CDbl(Rng.Value) > CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Case xlEqual
If CDbl(Rng.Value) = CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Case xlGreaterEqual
If CDbl(Rng.Value) = CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Case xlLess
If CDbl(Rng.Value)< CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Case xlLessEqual
If CDbl(Rng.Value)<= CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Case xlNotEqual
If CDbl(Rng.Value)<> CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Case xlNotBetween
If CDbl(Rng.Value)<= CDbl(FC.Formula1) Or _
CDbl(Rng.Value) >= CDbl(FC.Formula2) Then
ActiveCondition = Ndx
Exit Function
End If
Case Else
Debug.Print "UNKNOWN OPERATOR"
End Select
Case xlExpression
If Application.Evaluate(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Case Else
Debug.Print "UNKNOWN TYPE"
End Select
Next Ndx
End If
ActiveCondition = 0
End Function
Function ColorIndexOfCF(Rng As Range, _
Optional OfText As Boolean = False) As Integer
Dim AC As Integer
AC = ActiveCondition(Rng)
If AC = 0 Then
If OfText = True Then
ColorIndexOfCF = Rng.Font.ColorIndex
Else
ColorIndexOfCF = Rng.Interior.ColorIndex
End If
Else
If OfText = True Then
ColorIndexOfCF = Rng.FormatConditions(AC).Font.ColorIndex
Else
ColorIndexOfCF = Rng.FormatConditions(AC).Interior.ColorIndex
End If
End If
End Function
Now, place the following formula in a cell of your choice:
=CntCondCol(G3:X60,A1)
Change A1 to a cell reference that has the same shading that you want to count. The beauty of this is that the reference cell (in this case a1) can either be shaded by conditional formatting or manual/standard formatting.
This works pretty well on xl2000. Hope this helps. Cheers,
Nate
This message was edited by nateo on 2002-03-13 10:07