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

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.