Increase Speed of Formatting Macro Using Union()

Question

I'm writing a formatting macro for a report, but what I've come up with is not running nearly as quickly as I'd like. Any help or suggestions to increase speed would be greatly appreciated.

My thought when putting together the below code was that if I iterate through each row, and determine the ranges that need to have formatting applied to them merging into a single range using union(), and then apply the format at the end, it would be faster than applying the format for each row individually. I'm not sure this is the case, considering how long this code took to run for about 40k rows.

Dim FinalRowReport As Long
Dim i As Long
Dim rangeFormat As Range
Dim rangeBold As Range
Dim rangeColor As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

FinalRowReport = Cells(Rows.Count, 1).End(xlUp).Row

For i = 4 To FinalRowReport
    If Cells(i, 2) = Cells(i - 1, 2) Then
        If rangeColor Is Nothing Then
            Set rangeColor = Range(Cells(i, 1), Cells(i, 12))
        Else
            Set rangeColor = Union(rangeColor, Range(Cells(i, 1), Cells(i, 12)))
        End If
    End If
    If Right(Cells(i, 2).Value, 5) = "Total" Then
        If rangeFormat Is Nothing Then
            Set rangeFormat = Range(Cells(i, 1), Cells(i, 19))
            Set rangeBold = Range(Cells(i, 20), Cells(i, 23))
        Else
            Set rangeFormat = Union(rangeFormat, Range(Cells(i, 1), Cells(i, 23)))
            Set rangeBold = Union(rangeBold, Range(Cells(i, 20), Cells(i, 23)))
        End If
    End If
Next i

rangeColor.Font.Color = RGB(255, 255, 255)
rangeFormat.Interior.Color = RGB(217, 217, 217)
rangeFormat.Font.Color = RGB(217, 217, 217)
rangeBold.Interior.Color = RGB(217, 217, 217)
rangeBold.Font.Bold = True
With rangeFormat.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThick
End With

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

The code does work - it's just extremely long, maybe like 20 minutes. Any help would be greatly appreciated.

I deleted my answer as you say the code you provided was not its entirety. plus there were extra steps you were taking to help speed up your macro ie. turning off auto calcs. etc.. Once you update your question with the full code we can help further — alowflyingpig, Jun 13 '19 at 00:09
There was a lot more to this macro than just this code snippet (also involves refreshing external queries and pivot tables, copying/pasting data). I didn't want to showcase irrelevant code as I've narrowed it down to this block of code being the culprit. — Valantic, Jun 13 '19 at 00:12
Check how long it takes when an automatic calculation is restored: `Application.Calculation = xlCalculationAutomatic`. Loading data into an array and working on array data instead of cells would speed up but it isn't the case of 20 minutes, so the problem is somewhere else. — Ryszard Jędraszyk, Jun 13 '19 at 04:15

Tim Williams · Accepted Answer · 2019-06-14T01:12:22.697

Cell-by-cell reading of data is typically slower than loading to an array and reading from there.

Dim FinalRowReport As Long
Dim i As Long
Dim rangeFormat As Range
Dim rangeBold As Range
Dim rangeColor As Range
Dim data

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

FinalRowReport = Cells(Rows.Count, 1).End(xlUp).Row
data = Cells(1, 2).Resize(FinalRowReport).Value 

For i = 4 To FinalRowReport
    If data(i, 1) = data(i - 1, 1) Then
        BuildRange rangeColor, Range(Cells(i, 1), Cells(i, 12))
    End If
    If Right(data(i, 1).Value, 5) = "Total" Then
        BuildRange rangeFormat, Range(Cells(i, 1), Cells(i, 19))
        BuildRange rangeBold = Range(Cells(i, 20), Cells(i, 23))     
    End If
Next i

rangeColor.Font.Color = RGB(255, 255, 255)
rangeFormat.Interior.Color = RGB(217, 217, 217)
rangeFormat.Font.Color = RGB(217, 217, 217)
rangeBold.Interior.Color = RGB(217, 217, 217)
rangeBold.Font.Bold = True
'...
'...

'utility sub for building a range
Sub BuildRange(ByRef rngTot As Range, rngAdd as range)
    if rngTot is nothing then
        set rngTot = rngAdd
    else
        set rngTot = application.union(rngTot, rngAdd)
    end if

end sub

EDIT - a little testing based on Valantic's comment about batching the range building every so often. It makes more difference than I'd expected.

Test Code:

Sub TTT()
    Const N_COMMIT = 500 '<< "commit" and reset the range every this many unions
    Dim i As Long, t, c, rng As Range, n As Long

    Columns(1).Interior.ColorIndex = xlNone

    t = Timer
    For i = 1 To 2000# Step 1

        BuildRange rng, Cells(i * 2, 1)
        n = n + 1

        If n >= N_COMMIT Then
            rng.Interior.Color = vbRed
            Set rng = Nothing
            n = 0
        End If

        If i Mod 250 = 0 Then Debug.Print i, Timer - t
    Next i

    If Not rng Is Nothing Then rng.Interior.Color = vbRed

End Sub

Results: total time taken depends on commit frequency, with 25 (in my tests) being the "sweet spot" in terms of performance. Note this plot is log scale on the y-axis (Time in secs)

Thank you for your suggestion Tim. I was able to drastically increase the speed by executing the formatting on the unioned range variables whenever i mod 500 = 0, then setting them equal to Nothing. It loops through the 40K rows in less than 10 seconds. — Valantic, Jun 14 '19 at 00:23
Good idea - I did wonder how large those ranges were getting but had not thought to batch the updates and reset them periodically. — Tim Williams, Jun 14 '19 at 00:30

Increase Speed of Formatting Macro Using Union()

1 Answers1

Linked