List Conditional Formatting in Excel 2003

I recently complained about listing conditional formatting in 2007. Now it’s time to do 2003.

Excel 2003 was a little easier in some ways and harder in others. Far less “Types” to worry about, but no AppliesTo property. So I had to go cell by cell and check for FormatConditions. Whenever my code starts to get messy, it’s time for a class or two.

Sub ShowConditionalFormatting()
         
          Dim cf As Variant
          Dim rCell As Range
          Dim rSame As Range
          Dim colFormats As Collection
          Dim i As Long
          Dim wsOutput As Worksheet
          Dim rNext As Range
          Dim clsCondForms As CCondForms
          Dim clsCondForm As CCondForm
         
10        Set wsOutput = ThisWorkbook.Worksheets.Add
20        wsOutput.Range(“A1:E1”).Value = Array(“Type”, “Range”, “StopIfTrue”, “Formual1”, “Formual2”)
30        Set clsCondForms = New CCondForms
         
40        For Each rCell In Sheet1.Cells.SpecialCells(xlCellTypeAllFormatConditions).Cells
50            For i = 1 To rCell.FormatConditions.Count
60                Set clsCondForm = New CCondForm
70                Set clsCondForm.FormCond = rCell.FormatConditions(i)
80                Set clsCondForm.AppliesTo = rCell
                 
90                If clsCondForms.Exists(clsCondForm) Then
100                   clsCondForms.CondForm(clsCondForm.CondFormID).Merge clsCondForm
110               Else
120                   clsCondForms.Add clsCondForm
130               End If
                 
140           Next i
150       Next rCell
         
160       For i = 1 To clsCondForms.Count
170           Set clsCondForm = clsCondForms.CondForm(i)
180           wsOutput.Cells(i + 1, 1).Resize(1, 5).Value = clsCondForm.WriteArray
190       Next i
         
200       wsOutput.UsedRange.EntireColumn.AutoFit
         
End Sub

Let’s see what it does line-by-line. Line 10 adds a new worksheet to the workbook. This will be where the results are displayed. Line 20 puts the headers on the worksheet.

I have two classes, CCondForm and CCondForms. The latter is the parent of the former. That is, CCondForms is a collection of a bunch of CCondForm objects. We’ll dig into the classes, but for now, in Line 30, I’m creating a new CCondForms object so I have a place to store all the CCondForm objects I’ll be creating shortly.

Staring in Line 40, I’m looping through all the cells that have conditional formatting. Then I’m looping through all of the FormatConditions in each cell. For every one that I find (each cell can have up to three), I create a new CCondForm object. In the end, however, I don’t want a CCondForm object for every cell. Rather, I want one for every range that has the same FormatCondition. So while I create a CCondForm object now, I’ll only add it to the CCondForms collection if it’s “new”.

CCondForm only has two read/write properties; FormCond, a FormatCondition, and AppliesTo, a Range. In Lines 60-80 I create a new CCondForm object and write it’s two properties. Because they are objects (not strings or longs or doubles) I use the Set keyword.

Now that I’ve established my new CCondForm object, I need to see if I already have one in the collection. There doesn’t appear to be any way to uniquely identify a FormatCondition. I ended up concatenating Formula1 and Formula2. I figured if those two properties are the same, then it’s the same FC. I’m sure there’s a gotcha in there somewhere. In Lines 90-130, I check to see if there’s a match. If there is, I combine the two objects into one. If there isn’t, I add it to the collection.

Public Property Get Exists(clsCondForm As CCondForm) As Boolean
   
    Dim bReturn As Boolean
    Dim clsTemp As CCondForm
    Dim i As Long
   
    bReturn = False
   
    For i = 1 To Me.Count
        Set clsTemp = Me.CondForm(i)
       
        If clsTemp.CondFormID = clsCondForm.CondFormID Then
            bReturn = True
            Exit For
        End If
    Next i
   
    Exists = bReturn
   
End Property

The Exists property loops through all the CCondForm objects and looks for one with the same CondFormID. If it finds one, that means there’s a match and Exists returns TRUE. CondFormID is a read only property (there’s a get, but no let) and looks like this.

Public Property Get CondFormID() As String
   
    CondFormID = Me.Formula1 & Me.Formula2

End Property

Public Property Get Formula1() As String
   
    On Error Resume Next
        Formula1 = “‘” & Me.FormCond.Formula1
       
End Property

Public Property Get Formula2() As String
   
    On Error Resume Next
        Formula2 = “‘” & Me.FormCond.Formula2
       
End Property

I got tired of On Error-ing (you get an error if there’s not Formula2) so I just made custom properties that return Formula1 and Formula2, or an empty string if there isn’t one. If a match is found, the new CCondForm and the existing CCondForm are merged via the Merge method. It’s a dandy.

Public Sub Merge(clsToMerge As CCondForm)
   
    Set Me.AppliesTo = Union(Me.AppliesTo, clsToMerge.AppliesTo)
   
End Sub

Yep, not much to that. If the CF is the same, I just make the AppliesTo range bigger by Unioning the existing range with the new one. If A1 is already in there with =MOD(ROW(),2)=1, and A2 has the same CF, the Merge simply makes the AppliesTo property of the existing CCondForm object A1:A2. Then A1:A3 and on and on until it runs out of cells.

By the time I get to Line 160, I have a number of CCondForm objects in my CCondForms collection object (Three in this example). I loop through them and use the read-only property WriteArray to dump the relevant data to a range.

Public Property Get WriteArray() As Variant
   
    Dim aReturn(1 To 1, 1 To 5) As Variant
   
    aReturn(1, 1) = Me.CfType
    aReturn(1, 2) = Me.AppliesTo.Address
    aReturn(1, 3) = True
    aReturn(1, 4) = Me.Formula1
    aReturn(1, 5) = Me.Formula2
   
    WriteArray = aReturn
       
End Property

Public Property Get CfType() As String
   
    If Me.FormCond.Type = 1 Then
        CfType = “Cell Value”
    Else
        CfType = “Expression”
    End If
   
End Property

Nothing fancy, just abstracting it out of my main code and into a class. I put StopIfTrue as True for everything. I don’t know if that’s the case in 2003, but I think it is. It’s irrelevant because you can’t change it, but I wanted to keep the output consistent with my previous blog post.

You can download ListFormatConditions.zip

Posted in Uncategorized

12 thoughts on “List Conditional Formatting in Excel 2003

  1. “I ended up concatenating Formula1 and Formula2. I figured if those two properties are the same, then it’s the same FC. I’m sure there’s a gotcha in there somewhere”

    yes, you also need to test FormCond.operator. It could be 1=Between, or 2=Not between

    Patrick

  2. Why not using builtinproperties ?

    Sub tst()
      On Error Resume Next
      c01 = “Type|Range|Formula1|Operator|Formula2”
      For Each cl In Sheet1.Cells.SpecialCells(xlCellTypeAllFormatConditions)
        If InStr(c01, cl.SpecialCells(xlCellTypeSameFormatConditions).Address) = 0 Then
          For j = 1 To cl.FormatConditions.Count
            With cl.FormatConditions(j)
              c01 = c01 & vbCr & Choose(.Type, “Cell Value”, “Expression”) & “|” & cl.SpecialCells(xlCellTypeSameFormatConditions).Address & “|” & .Formula1
              c02 = “|” & .Operator & “|” & .Formula2
            End With
            If Err.Number = 0 Then c01 = c01 & c02
            Err.Clear
          Next
        End If
      Next
       
      With Sheet3.Cells(10, 1).Resize(UBound(Split(c01, vbCr)) + 1)
        .Value = WorksheetFunction.Transpose(Split(c01, vbCr))
        .TextToColumns , 1, -4142, , False, False, False, False, True, “|”
      End With
    End Sub
  3. Dick,

    I haven’t read the previous article, but I assume the code here is adapted from that?

    There is a problem here, because if you have an expression with a cell reference in the formula, it will report the formula from the activecell, unlike 2007. So, as an example, if G6 has a second condition of =G6>100, and G8 and G10 have the same condition, your report shows

    Expression$G$6,$G$8,$G$10TRUE=A1>100

    which is obviously nonsense. It is easy to correct as I show on my page on CF conditions, but even corrected your approach will show

    Expression$G$6,$G$8,$G$10TRUE=G6>100

    which is more accurate, but it assumes that the user understands how CF adjusts. In this case it would be far better to sho it as

    Expression$G$6TRUE=G6>100
    Expression$G$8TRUE=G8>100
    Expression$G$10TRUE=G10>100

  4. You guys will know this, but for visitors:

    ‘http://spreadsheetpage.com/index.php/oddity/C39/
    ‘The Elusive Formula1 Property For Conditional Formatting
    ‘When a Conditional Formatting formula uses a relative range reference,
    ‘accessing the Formula1 property via VBA will give you a different formula, depending on the active cell position!
    ‘In order to retrieve the actual Formula1 property value, you need to convert the formula to R1C1 notation
    ‘ using the active cells as the reference. Then convert that R1C1 formula back to A1 style.
    ‘The procedure below returns the actual Formula1 value, regardless of the active cell position.
    Sub TestFormula1()
    Dim F1 As String, F2 As String
    F1 = Range(“A1?).FormatConditions(1).Formula1
    F2 = Application.ConvertFormula(F1, xlA1, xlR1C1, , ActiveCell)
    F1 = Application.ConvertFormula(F2, xlR1C1, xlA1, , Range(“A1?))
    MsgBox F1
    End Sub

  5. Hi,

    This is extremely useful.

    Excel 2003.

    I would like to use your code to test against a defined range (starting from A1 and going to a user entered last cell), and see if a cell has any CF’s.

    If it does then I would like to be able to write out the CF’s that apply to that cell, and then move on to the next cell in the range and repeat the process – skipping any cells taht do not have CF’s.

    I have tried (and failed dismally) to amend your code to achieve this – please can you tell me what do I need to do?

    Your way is much better, but I want to use my way to compare 2 sheets which should be identical.

  6. I needed to change a range name within a CF formula in approximately 200 cells * 10 worksheets, so I wrote a program to do it. It is not the best, but it did the job (it worked because there was only 1 CF per cell). The CF is used to change the cell colour if data entered is different to a default sheet (used for forecasting – where input cells are pre-poulated with previous forecast data).

    I just thought that I would share it in case anyone wanted to do something similar.

    Sub Report_xFormats()
    ‘———————————————-
    Dim oFC As FormatCondition
    Dim sF1 As String
    Dim int_row As Integer
    Dim intrwindex As Integer
    Dim intcolindex As Integer

    range(“A1?).Select
    For intrwindex = 8 To 326
    For intcolindex = 2 To 6

    If Cells(intrwindex, intcolindex).FormatConditions.Count > 0 Then
    For Each oFC In Cells(intrwindex, intcolindex).FormatConditions

    Cells(intrwindex, intcolindex).Select

    With Cells(intrwindex, intcolindex).FormatConditions.item(1)

    sF1 = oFC.Formula1
    sF1 = application.WorksheetFunction.Substitute(oFC.Formula1, “LM_LAL”, “LM_AUT”)

    End With

    Cells(intrwindex, intcolindex).FormatConditions.item(1).Modify xlExpression, “”, sF1, “”

    Next oFC
    End If

    Next intcolindex
    Next intrwindex

    application.ScreenUpdating = True
    MsgBox “Conditional Formats done”

    End Sub

  7. @Alan,

    >> For Each oFC In Cells(intrwindex, intcolindex).FormatConditions
    >> Cells(intrwindex, intcolindex).Select
    >> With Cells(intrwindex, intcolindex).FormatConditions.item(1)
    >> sF1 = oFC.Formula1
    >> sF1 = application.WorksheetFunction.Substitute(oFC.Formula1, “LM_LAL”, “LM_AUT”)
    >> End With
    >> Cells(intrwindex, intcolindex).FormatConditions.item(1).Modify xlExpression, “”, sF1, “”
    >> Next oFC

    A couple of comments about this portion of the code you posted. First, you do not need this line of code…

    Cells(intrwindex, intcolindex).Select

    since you do nothing with the selection once you make it. Besides, this link of code continually selects the same cell each time it is executed. You would need to do this if you wanted to select each cell you iterated…

    oFC.Select

    but, I repeat, there is no need to select any cells in order to do what your code is doing. Second, you do not need the With/End With blocking because nothing within the block is using a dotted reference to the With statement’s object. Third, you do not need this line of code either…

    sF1 = oFC.Formula1

    because the very next line of code overwrites it. Fourth, instead of calling out to the SUBSTITUTE worksheet function in this line…

    sF1 = application.WorksheetFunction.Substitute(oFC.Formula1, “LM_LAL”, “LM_AUT”)

    you can use the built-in VB Replace function instead…

    sF1 = Replace(oFC.Formula1, “LM_LAL”, “LM_AUT”)

    As written, the Replace function is case sensitive and will only find “LM_LAL” when the letters are upper case as shown. If you need to be able to find that text whether the letters are upper or lower case (which is how the SUBSTITUTE function works), then use this line of code instead…

    sF1 = Replace(oFC.Formula1, “LM_LAL”, “LM_AUT”, , , vbTextCompare)

    Fifth, I think this line of code…

    Cells(intrwindex, intcolindex).FormatConditions.Item(1).Modify xlExpression, “”, sF1, “”

    can be written like this instead since it is referencing the same cell that oFC is set to reference…

    oFC.Item(1).Modify xlExpression, “”, sF1, “”

    With those changes all in place, I think the following loop will work the same as the one I quoted above…

    For Each oFC In Cells(intrwindex, intcolindex).FormatConditions
      sF1 = Replace(oFC.Formula1, “LM_LAL”, “LM_AUT”)
      oFC.Item(1).Modify xlExpression, “”, sF1, “”
    Next oFC

    Note that these are off-top-of-the-head comments that have were not tested on actual data.

  8. Rick,

    I am really grateful for your insight and expertise and will incorporate your suggestions.

    Thank you for taking the time to help out.

Leave a Reply

Your email address will not be published. Required fields are marked *