vba: log cleaning macro: how to optimize for faster execution?

90 views Asked by At

I'm running a macro that I made to delete the log contents and reformat the table in case that any format changes occurred while using it, the macro does what I intended but it takes about 30 minutes to finish running, all the while excel is completely frozen and unusable. Upon checking task manager on the process usage column, it seems excel is only using about 12.5% of my processing capacity, is there any way that I can make this multithread or that I can optimize the code to not take forever?

P.S. I decided to apply the merging of cells in batches as I figured doing it for all cells at once might have been what was making the code run much slower but I didn't notice any real difference in execution time.

Code below:


Sub ClearAndFormatLogTable()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Easy Mode") ' Replace with your sheet name
    
    ' Turn off ScreenUpdating and Events to improve performance
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' Clear values and formats from range A7 to J50000
    ws.Range("A7:J50000").ClearContents
    ws.Range("A7:J50000").ClearFormats
    
    ' Merge cells in the first row (row 7)
    ws.Range("C7:J7").Merge
    ws.Range("C7").HorizontalAlignment = xlCenterAcrossSelection
    
    ' Copy format from the merged cell
    ws.Range("C7").Copy
    
    ' Apply the format in batches
    Dim i As Long
    For i = 8 To 50000 Step 1000
        ws.Range("C" & i & ":J" & Application.Min(i + 999, 50000)).PasteSpecial xlPasteFormats
    Next i
    
    Application.CutCopyMode = False ' Clear the copy mode
    
    ' Apply thick borders and dotted inner vertical divisions
    With ws.Range("B7:J50000")
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlThick
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).Weight = xlThick
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).Weight = xlThick
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Weight = xlThick
        .Borders(xlInsideHorizontal).LineStyle = xlDot
        .Borders(xlInsideVertical).LineStyle = xlDot
    End With
    
    ' Turn ScreenUpdating and Events back on
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Thanks in advance!

2

There are 2 answers

10
cranky On BEST ANSWER
Sub ClearAndFormatLogTable()
'Counter=0  Turn off the Counter
Counter = 1: stTime = Timer
'....................................................................................................
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Easy Mode") ' Replace with your sheet name
    
    ' Turn off ScreenUpdating and Events to improve performance
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' Clear values and formats from range A7 to J50000
    ws.Range("A7:J50000").ClearContents
    ws.Range("A7:J50000").ClearFormats
    
    ' Merge cells in the first row (row 7)
    ws.Range("C7:J7").Merge
    ws.Range("C7").HorizontalAlignment = xlCenterAcrossSelection

    'By using fill down instead of copy paste, results are obtained in 20-30 seconds.
    With ws.Range("C7:J50000")
        .FillDown
    End With
    
    ' Apply thick borders and dotted inner vertical divisions
    With ws.Range("B7:J50000")
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlThick
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).Weight = xlThick
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).Weight = xlThick
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Weight = xlThick
        .Borders(xlInsideHorizontal).LineStyle = xlDot
        .Borders(xlInsideVertical).LineStyle = xlDot
    End With
    
    ' Turn ScreenUpdating and Events back on
    Application.ScreenUpdating = True
    Application.EnableEvents = True
'....................................................................................................
    If Counter = 1 Then MsgBox _
    Round(Timer - stTime, 2) & " second", vbInformation, "Macro Time"
End Sub
1
MGonet On

A shorter version of setting borders:

Sub AddBorders()
    Dim tm As Double, ws As Worksheet
    Set ws = ActiveSheet
    tm = Timer
    ' Apply thick borders and dotted inner vertical divisions
    With ws.Range("B7:J50000")
        .Clear
        .BorderAround xlContinuous, xlThick
        .Borders(xlInsideHorizontal).LineStyle = xlDot
        .Borders(xlInsideVertical).LineStyle = xlDot
    End With
    MsgBox "Czas = " & Timer - tm    ' 0.95 s Borders
                                     ' 0.6 s BorderAround
End Sub