Merge Excel conditional formatting

Conditional formatting is a great tool, but after a spreadsheet has a lot of edits, the number of conditional rules spirals out of control.

To solve this I wrote a short VBA macro, which propagates conditional formatting (and only conditional formatting) from the top-most cell in each column. It’s a simplistic implementation, with the following restrictions:

• It replicates the formatting column-by-column, copying the conditional formatting from the first (top-most) cell which has some. Make sure that the rules you want propagated are topmost in the list and include that topmost cell before running.
• Corollary: It doesn’t handle multi-column formatting.

Paste the following code into a new module:

Option Explicit
Option Compare Text
Sub Test(xls As String)
    ' Open the workbook with conditional formatting.
    '   Test wookbookname
    ' in the immediate window
    ' this will merge the conditional formatting on the first worksheet of that book
    Dim wb As Workbook
    Set wb = Workbooks(xls)
    Dim ws As Worksheet
    Set ws = wb.Worksheets(1)
    MergeConditional ws
End Sub
Public Sub MergeConditional(ws As Worksheet)
    On Error GoTo FAIL
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Dim lur As Long
    lur = LastUsedRow(ws)
    Dim luc As Long
    luc = LastUsedCol(ws)
    Dim col As Integer
    Dim row As Long
    For col = 1 To luc
        Dim found As Boolean
        found = False
        Dim source As Range
        For row = 1 To lur
            Set source = ws.Cells(row, col)
            If source.FormatConditions.Count > 0 Then
                found = True
                Exit For
            End If
        Next row
        If found And row < lur Then
            ws.Range(ws.Cells(row + 1, col), ws.Cells(1048576, col)).FormatConditions.Delete
            Dim target As Range
            Set target = ws.Range(ws.Cells(row, col), ws.Cells(lur, col))
            Dim i As Integer
            For i = 1 To source.FormatConditions.Count
                source.FormatConditions(i).ModifyAppliesToRange target
            Next i
        End If ' found
    Next col
FAIL:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Private Function LastUsedCol(ws As Worksheet) As Long
    On Error Resume Next
    LastUsedCol = 1
    LastUsedCol = ws.Cells.Find("*", SearchOrder:=xlByColumns, LookIn:=xlValues, SearchDirection:=xlPrevious).Column
End Function
Private Function LastUsedRow(ws As Worksheet) As Long
    On Error Resume Next
    LastUsedRow = 1
    LastUsedRow = ws.Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).row
End Function