Changing the formatting of sheets

Question

This my program to change the formatting of sheets in different folders. I have over 5000 files in one folder and it is taking up to three hrs for one folder and there are multiple subfolders in the main folder. I want to cut down this time to 10 mins or as fast as possible.

Sub loopAllSubFolderSelectStartDirectory()
'Another Macro must call LoopAllSubFolders Macro to start to procedure
Call LoopAllSubFolders("D:\HTTP\")
End Sub
'Don’t run the following macro, it will be called from the macro above:
'List all files in sub folders
Sub LoopAllSubFolders(ByVal folderPath As String)
Dim fileName As String
Dim fullFilePath As String
Dim numFolders As Long
Dim folders() As String
Dim i As Long
Set wc = ActiveWorkbook
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
fileName = Dir(folderPath & "*.*", vbDirectory)
While Len(fileName) <> 0
 If Left(fileName, 1) <> "." Then
 fullFilePath = folderPath & fileName
 If (GetAttr(fullFilePath) And vbDirectory) = vbDirectory Then
 ReDim Preserve folders(0 To numFolders) As String
 folders(numFolders) = fullFilePath
 numFolders = numFolders + 1
 Else
Set wb = Workbooks.Open(fullFilePath)
Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant
fnd = "<*>"
rplc = ""
For Each sht In wb.Worksheets
On Error GoTo 0
 sht.Cells.Replace what:=fnd, Replacement:=rplc, _
 LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
 SearchFormat:=False, ReplaceFormat:=False
 Next sht
Workbooks("New file to be saved.xlsm").Sheets("Sheet1").Range("A1:T1").Copy
'Now, paste to y worksheet:
wb.ActiveSheet.Range("A1").PasteSpecial
Range("G2:H100").Cut Range("Q2:R100")
Range("B2:F100").Cut Range("F2:J100")
wb.ActiveSheet.Cells.EntireColumn.AutoFit
'With wb.ActiveSheet.Range("A1:T1").Interior
' .Pattern = xlSolid
' .PatternColorIndex = xlAutomatic
' .ThemeColor = xlThemeColorDark1
' .TintAndShade = -0.149998474074526
' .PatternTintAndShade = 0
' End With
' With wb.ActiveSheet.Range("A1:T1").Font
' .ThemeColor = xlThemeColorLight2
' .TintAndShade = 0
' End With
' Range("A1:T1").Font.Bold = True
 wb.SaveAs Replace(wb.FullName, ".csv", ".xls"), FileFormat:=xlExcel8
wb.Close True
Kill fullFilePath
 'Insert the actions to be performed on each file
 'This example will print the full file path to the immediate window
 'Debug.Print folderPath & fileName
 End If
 End If
fileName = Dir()
Wend
For i = 0 To numFolders - 1
 LoopAllSubFolders folders(i)
Next i
End Sub

• pacmaninbw: Have you measured how much time a single sheet takes to reformat?
• TinMan: Are you modifying both Excel and CSV formats? Or are you just converting CSV to xls? Why are you using the older xls instead of the new xlsx format?
• TinMan: Application.ScreenUpdating = False is going to give you a massive boost in speed. Optimize VBA Code to run Macros Faster.
• M Faizan Farooq: where to place it
• TinMan: The first line of code will work. There are other optimizations that can be made but it is hard to determine without sample files.

Answer 1

I use the following sub to speed up processing:

Public Sub AppSpeed(Optional iWhat As Long = xlDown)
 Dim bDir As Boolean
 bDir = True
 If iWhat = xlUp Then bDir = False
 On Error Resume Next
 With Application
 .Calculation = IIf(bDir, xlCalculationAutomatic, xlCalculationManual)
 .ScreenUpdating = bDir
 .DisplayStatusBar = bDir
 .EnableEvents = bDir
 .DisplayPageBreaks = bDir
 .PrintCommunication = bDir
 End With
End Sub

and I call it like

AppSpeed xlUp ' at the beginning of the app

and

AppSpeed xlDown ' az the end of processing

The inconvenience of this solution is that you can't monitor what's happening so Dim a counter like filecounter and put the following snippet somewhere in the loop e.g. after wb.SaveAs to see that something is happening

 filecounter = filecounter + 1
 If 100 * (filecounter \ 100) = filecounter Then
 AppSpeed xlDown
 Application.StatusBar = folderpath & " " & CStr(filecounter)
 DoEvents
 AppSpeed xlUp
 End If

Next advice is to reduce the number of files in one folder. The documenations do not really help in this matter. My experience is that it is worth to keep the number of files under 1000 in one folder because access time increases enormously over that. You have a flexible structure so can quickly test it by dividing the files to multiple folders.

• pacmaninbw: You might want to explain why the With statement helps speed up the execution.
• AcsErno: @pacmaninbw One purpose of With is to simplify the syntax. In my example I could replace Application.<property> with <.property> with the help of the preceeding With statement 6 times. So what really speeds up the app is to disable a few automated operations of Excel like recalculating page breaks after a .Cut or a .AutoFit operation x10K times by issuing an Application.DisplayPageBreaks = False especially in those cases when it needs communication with the printer.
• pacmaninbw: One use of With is to put the address of Application into a register and that speeds up the access of the member properties.