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!
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