Macro to fix Duplicated Conditional Formatting rules in Tables

Following on from my recent post of Fix duplicated Conditional Formatting Rules , I mentioned Debra Dalgaleish’s website page had some great VBA to fix duplicated Conditional Formatting rules.  I tweeked this code just a bit so that all you have to do is select anywhere in any Table in the active worksheet and it will do it’s stuff namely, clear Conditional Formatting from all rows except the first row then copy the Conditional Formatting from that first row to all other rows and the duplicate Conditional Formatting rules are gone.  Plus it has a bit of error trapping in case you forget to choose a cell within the Table first.

[vb]

Sub FixTableCondFormatDupRules(control As IRibbonControl)
‘Debra Dalgleish https://www.contextures.com/xlCondFormat01.html with some minor tweeks by John Hackwood theExcelFactor.com

Dim ws As Worksheet
Dim MyList As ListObject
Dim lRows As Long
Dim rngData As Range
Dim rngRow1 As Range
Dim rngRow2 As Range
Dim rngRowLast As Range

On Error Resume Next
If Selection.ListObject.Name = 0 Then
On Error GoTo 0
MsgBox “Activecell is not in a Table so this process will end – select a cell within a Table FIRST then try again”, vbCritical, “Process to clean up Table Duplicate Conditional Formatting Rules”
Exit Sub
End If

Set ws = ActiveSheet
Set MyList = Selection.ListObject
Set rngData = MyList.DataBodyRange
lRows = rngData.rows.Count
Set rngRow1 = rngData.rows(1)
Set rngRow2 = rngData.rows(2)
Set rngRowLast = rngData.rows(lRows)

With ws.Range(rngRow2, rngRowLast)
.FormatConditions.Delete
End With

rngRow1.Copy
With ws.Range(rngRow1, rngRowLast)
.PasteSpecial Paste:=xlPasteFormats
End With

rngRow1.Cells(1, 1).Select
Application.CutCopyMode = False

End Sub
[/vb]