Delete Excel individual format condition - excel

Question

I have an old workbook with Conditional Formatting that has got out of hand in terms of random conditional formatting having evolved. I would like to loop through the sheet and delete all the conditional formatting that only refers to one cell (but preserve other formatting in the same cell and of course preserve the cell value etc.)
I have written the code in a separate sheet so that (1) I can re-use it and (2) the workbook itself doesn't need macros
So far, I can identify the cells but can't delete the formatting. The code I have is:
Option Explicit
Sub Delete_Conditional()
Dim fc As FormatCondition
Dim lLastRow As Long, lLastCol As Long
Dim rAllCells As Range, rCell As Range
Dim ws As Worksheet
Dim wb As Workbook
Set wb = Workbooks("Book1.xlsx")
Set ws = wb.Worksheets("Sheet1")
'Find last cell and set a range to cover all cells
lLastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
lLastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
Set rAllCells = Range(Cells(1, 1), Cells(lLastRow, lLastCol))
'Loop through all cells
For Each rCell In rAllCells.Cells
'Loop through all FormatConditions in the cell
For Each fc In rCell.FormatConditions
'Determine if the FormatCondition only applies to one cell
If fc.AppliesTo.Cells.Count = 1 Then
Debug.Print fc.AppliesTo.Address
'I have tried fc.Delete
'I have tried fc.AppliesTo.Delete
End If
Next fc
Next rCell
End Sub
When I go back to the sheet, I can see the formatting still exists.

Answer 1

When deleting from a collection of items sometimes it works better if you work backwards:
Sub Delete_Conditional()
Dim fc As FormatCondition
Dim lLastRow As Long, lLastCol As Long
Dim rAllCells As Range, rCell As Range
Dim ws As Worksheet
Dim wb As Workbook, i As Long
Set wb = Workbooks("Book1.xlsx")
Set ws = wb.Worksheets("Sheet1")
'Find last cell and set a range to cover all cells
lLastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
lLastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
Set rAllCells = Range(Cells(1, 1), Cells(lLastRow, lLastCol))
'Loop through all cells
For Each rCell In rAllCells.Cells
'Loop through all FormatConditions in the cell
For i = rCell.FormatConditions.Count To 1 Step -1
With rCell.FormatConditions(i)
If .AppliesTo.Cells.Count = 1 Then
Debug.Print .AppliesTo.Address
.Delete
End If
End With
Next i
Next rCell
End Sub