Unfortunately, the Color and ColorIndex properties of a
Range don't return the color of a cell that is displayed if Conditional
formatting is applied to the cell. Nor does it allow you to determine
whether a conditional format is currently in effect for a cell.
In order to determine these, you need code that will
test the format conditions. This page describes several VBA functions that
will do this for you.
ActiveCondition
This function will return the number of the condition that is currently
applied to the cell. If the cell does not have any conditional formatting
defined, or none of the conditional formats are currently applied, it
returns 0. Otherwise, it returns 1, 2, or 3, indicating with format
condition is in effect. ActiveCondition
requires the
GetStrippedValue
function at the bottom of this page.
NOTE: ActiveCondition may result in an inaccurate result if the
following are true:
-
You are calling ActiveCondtion from a worksheet cell, AND
-
The cell passed to ActiveCondtion uses a "Formula Is" rather than
"Cell Value Is" condition, AND
-
The formula used in the condition formula contains relative
addresses
To prevent this problem, you must use absolute cell
address in the condition formula.
ColorOfCF
This function will return the RGB color in effect for either the text or the
background of the cell. This function requires the
ActiveCondition
function. You can call this function directly from a worksheet cell with a
formula like:
=ColorOfCF(A1,FALSE)
ColorIndexOfCF
This function will return the color index in effect for either the text or
the background of the cell. This function requires the
ActiveCondition
function. You can call this function directly from a worksheet cell
with a formula like:
=ColorIndexOfCF(A1,FALSE)
CountOfCF
This function return the number of cells in a range that have a specified conditional
format applied. Set the last argument to -1 to look at all format
conditions, or a number between 1 and 3 to specify a particular condition. This function requires the
ActiveCondition
function. You can call this function directly from a worksheet cell
with a formula like:
=CountOfCF(A1:A10,1)
SumByCFColorIndex
This function sums the cells that have a specified
background color applied by conditional formatting.
'''''''''''''''''''''''''''''''''''''''
Function ActiveCondition(Rng As
Range) As Integer
Dim Ndx As Long
Dim FC As FormatCondition
Dim Temp As Variant
Dim Temp2 As Variant
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
Temp = GetStrippedValue(FC.Formula1)
Temp2 = GetStrippedValue(FC.Formula2)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) >= CDbl(FC.Formula1) And _
CDbl(Rng.Value) <= CDbl(FC.Formula2) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value >= Temp And _
Rng.Value <= Temp2 Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlGreater
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) > CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value > Temp Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) = CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Temp = Rng.Value Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlGreaterEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) >= CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value >= Temp Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlLess
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) < CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value < Temp Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlLessEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) <= CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value <= Temp Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlNotEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) <> CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Temp <> Rng.Value Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlNotBetween
Temp = GetStrippedValue(FC.Formula1)
Temp2 = GetStrippedValue(FC.Formula2)
If IsNumeric(Temp) Then
If Not (CDbl(Rng.Value) <= CDbl(FC.Formula1)) And _
(CDbl(Rng.Value) >= CDbl(FC.Formula2)) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Not Rng.Value <= Temp And _
Rng.Value >= Temp2 Then
ActiveCondition = Ndx
Exit Function
End If
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
'''''''''''''''''''''''''''''''''''''''
Function ColorOfCF(Rng As Range, Optional OfText As Boolean = False) As Long
Dim AC As Integer
AC = ActiveCondition(Rng)
If AC = 0 Then
If OfText = True Then
ColorOfCF = Rng.Font.Color
Else
ColorOfCF = Rng.Interior.Color
End If
Else
If OfText = True Then
ColorOfCF =
Rng.FormatConditions(AC).Font.Color
Else
ColorOfCF =
Rng.FormatConditions(AC).Interior.Color
End If
End If
End Function
'''''''''''''''''''''''''''''''''''''''
Function GetStrippedValue(CF As
String) As String
Dim Temp As String
If InStr(1, CF, "=", vbTextCompare) Then
Temp = Mid(CF, 3, Len(CF) - 3)
If Left(Temp, 1) = "=" Then
Temp = Mid(Temp, 2)
End If
Else
Temp = CF
End If
GetStrippedValue = Temp
End Function
'''''''''''''''''''''''''''''''''''''''
Function CountOfCF(InRange As
Range, _
Optional Condition As Integer = -1) As Long
Dim Count As Long
Dim Rng As Range
Dim FCNum As Integer
For Each Rng In InRange.Cells
FCNum = ActiveCondition(Rng)
If FCNum > 0 Then
If Condition
= -1 Or Condition = FCNum Then
Count = Count + 1
End If
End If
Next Rng
CountOfCF = Count
End Function
'''''''''''''''''''''''''''''''''''''''
Function SumByCFColorIndex(Rng
As Range, CI As Integer) As Double
Dim R As Range
Dim Total As Double
For Each R In Rng.Cells
If ColorIndexOfCF(R, False) = CI Then
Total = Total
+ R.Value
End If
Next R
SumByCFColorIndex = Total
End Function
For more information, see the
Functions For Working With Cell Colors and the
Conditional Formatting pages.
|