Count by fiil color
Harlan,
This is similar to a routine I have for getting CF colorindex (obvious I
suppose, there is only one way really), but I was interested to check if you
had solved the problem that I have with the colorindexs when a CF expression
is used. Interestingly, you have improved upon it, and it seems to be the
adjustment of the formula from the caller's address. This is neat, it really
seems to improve my routine - lots more checking to do yet, but it looks
promising, so I thank you in advance.
Still seems to be a problem if the formula has no anchoring cell reference
(such as =MOD(ROW(),3)=1), but in many instances this can be circumvented by
better formula definition (=MOD(ROW(A1),3)=1). I am sure that there are
still problems out there, after all why it doesn't work by just checking the
colorindex suggests something wrong in the engine room, but it's a good
step forward.
--
HTH
Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
"Harlan Grove" wrote in message
...
"Frank Kabel" wrote...
unfortunately there is nothing you can do. Colors created by a
conditional format can not be evaluated in VBA. That is if you check
the colorindex in VBA always the default color index is returned.
Wrong. While cells' color properties don't reflect colors set by
conditional
formatting, those cells have FormatConditions collection object
properties,
and those *CAN* be evaluated in VBA. The only trick is catching relative
cell refs in formula conditions, replacing refs to Application.Caller with
refs to cells in the proper range. This isn't fool-proof, but it handles
most likely situations.
Function ugh(rng As Range, ci As Variant) As Long
Dim f As FormatCondition, x As String, r As Range, a As String
a = Application.Caller.Address(0, 0)
For Each r In rng
For Each f In r.FormatConditions
If f.Interior.ColorIndex = ci Then
If f.Type = xlExpression Then
x = Application.WorksheetFunction.Substitute(f.Formula 1, _
a, r.Address(0, 0))
If Evaluate(x) Then ugh = ugh + 1
ElseIf (f.Operator = xlEqual And r.Value = f.Formula1) _
Or (f.Operator = xlNotEqual And r.Value < f.Formula1) _
Or (f.Operator = xlLess And r.Value < f.Formula1) _
Or (f.Operator = xlLessEqual And r.Value <= f.Formula1) _
Or (f.Operator = xlGreater And r.Value f.Formula1) _
Or (f.Operator = xlGreaterEqual And r.Value = f.Formula1) Then
ugh = ugh + 1
ElseIf (f.Operator = xlBetween And f.Formula1 <= r.Value _
And r.Value <= f.Formula2) Or (f.Operator = xlNotBetween _
And (r.Value < f.Formula1 Or f.Formula2 < r.Value)) Then
ugh = ugh + 1
End If
End If
Next f
Next r
End Function
|