Pearson Software Consulting Services

    Conditional Formatting Colors 

         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.

 

 

 

 

 Created By Chip Pearson and Pearson Software Consulting, LLC 
This Page:                Updated: November 06, 2013     
MAIN PAGE    About This Site    Consulting    Downloads  
Page Index     Search    Topic Index    What's New   
Links   Legalese And Disclaimers
chip@cpearson.com

© Copyright 1997-2007  Charles H. Pearson