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.
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.
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.
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.
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.
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.
“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
Why not using builtinproperties ?
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
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
I forgot to say that this assumes A1 is the activecell when you run the macro.
Or you could show the formulas in R1C1 format so each cell would show RC>100 ?
Bob: Where on your site do you discuss how to fix this?
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
Dick, it’s at http://www.xldynamic.com/source/xld.CFConditions.html
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.
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
@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…
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…
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…
because the very next line of code overwrites it. Fourth, instead of calling out to the SUBSTITUTE worksheet function in this line…
you can use the built-in VB Replace function instead…
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…
Fifth, I think this line of code…
can be written like this instead since it is referencing the same cell that oFC is set to reference…
With those changes all in place, I think the following loop will work the same as the one I quoted above…
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.
Rick,
I am really grateful for your insight and expertise and will incorporate your suggestions.
Thank you for taking the time to help out.