VBA Slowing Down as Macro Loops

[Mlspencer08]

Hi everyone! First post here but have definitely loved getting tips/tricks over the years. Here's my problem:

I have a macro that opens a "template" Excel file, saves the file with a different name, and then does the process again...and again...and again. The Excel files are being created based on the listing of text files in a different folder. This is part of something I'm going to do later where I actually populate each of the files with the data from the text file - but first I want to just create all the Excel files - thousands of them.

The code works 100% like I would expect it to, other than the fact that it starts to slow down after 10-15 minutes. At the start, it will process/loop one file every 3-4 seconds, then after a few minutes it slows down to 6-8 seconds, and by the time I'm 20-30 minutes in it's taking a solid 15 seconds per loop.

Is there a memory cache or something that's filling up that I can clear as part of the macro? Or can I tell it to periodically stop/start so that it "resets" itself? Sorry if these are silly questions, but I feel like if the macro runs in 3 seconds the first time, there has to be a way to keep it running at that 3 seconds continually...

Here's the code:

Sub TextFileLoop()
'
' TextFileLoop Macro
'
'Variable Declaration
    Dim sFilePath As String
    Dim sFileName As String
    Dim sFileNameLength As String
    Dim sExcelFileName As String
    
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    Range("A1").Select
    
    'Specify File Path
    sFilePath = "C:\ProgramData\Kibot Agent\Data"
    
    'Check for back slash
    If Right(sFilePath, 1) <> "\" Then
        sFilePath = sFilePath & "\"
    End If
        
    sFileName = Dir(sFilePath & "*.txt")
    
    Do While Len(sFileName) > 0
        'Set file name length equal to the full length less 4 so it's equal to just the symbol name
        sFileNameLength = Len(sFileName) - 4
        'Create variable that will then get used to save the new file name
        sExcelFileName = Left(sFileName, sFileNameLength)
        'Open the "Name -" analysis file template
        Workbooks.Open Filename:= _
        "C:\Users\MattSpencer\Desktop\Personal\Spencer Financial Group\Trading Strategies\Swing Trading\Reversal Candles\Name -.xlsx"
        ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\MattSpencer\Desktop\Personal\Spencer Financial Group\Trading Strategies\Swing Trading\Reversal Candles\Analysis Files\Name - " & sExcelFileName & ".xlsx"
        ActiveWorkbook.Close Filename:= _
        "C:\Users\MattSpencer\Desktop\Personal\Spencer Financial Group\Trading Strategies\Swing Trading\Reversal Candles\Analysis Files\Name - " & sExcelFileName & ".xlsx"
        'Set the fileName to the next available file
        If Not (Application.VBE.MainWindow.Visible) Then
        Application.VBE.MainWindow.Visible = True
        Application.VBE.MainWindow.Visible = False
        End If
        sFileName = Dir
    Loop
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
End Sub

Any advice is welcome, thank you!

 

[6StringJazzer]

I do not think this would cause a performance problem but it is not a good practice to rely on ActiveWorkbook. This approach may keep the environment a tad cleaner but I'm not sure.

Sub TextFileLoop()
'
' TextFileLoop Macro
'
'Variable Declaration
    Dim sFilePath As String
    Dim sFileName As String
    Dim sFileNameLength As String
    Dim sExcelFileName As String
    Dim NewWB As Workbook
    
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    Range("A1").Select
    
    'Specify File Path
    sFilePath = "C:\ProgramData\Kibot Agent\Data"
    
    'Check for back slash
    If Right(sFilePath, 1) <> "\" Then
        sFilePath = sFilePath & "\"
    End If
        
    sFileName = Dir(sFilePath & "*.txt")
    
    Do While Len(sFileName) > 0
        'Set file name length equal to the full length less 4 so it's equal to just the symbol name
        sFileNameLength = Len(sFileName) - 4
        'Create variable that will then get used to save the new file name
        sExcelFileName = Left(sFileName, sFileNameLength)
        'Open the "Name -" analysis file template
        
        Set NewWB = Workbooks.Open(Filename:= _
        "C:\Users\MattSpencer\Desktop\Personal\Spencer Financial Group\Trading Strategies\Swing Trading\Reversal Candles\Name -.xlsx")
        
        NewWB.SaveAs Filename:= _
        "C:\Users\MattSpencer\Desktop\Personal\Spencer Financial Group\Trading Strategies\Swing Trading\Reversal Candles\Analysis Files\Name - " & sExcelFileName & ".xlsx"
        
        NewWB.Close Filename:= _
        "C:\Users\MattSpencer\Desktop\Personal\Spencer Financial Group\Trading Strategies\Swing Trading\Reversal Candles\Analysis Files\Name - " & sExcelFileName & ".xlsx"
        
        'Set the fileName to the next available file
        If Not (Application.VBE.MainWindow.Visible) Then
        Application.VBE.MainWindow.Visible = True
        Application.VBE.MainWindow.Visible = False
        End If
        sFileName = Dir
    Loop
    
    Set NewWB = Nothing

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
End Sub

This is not causing your problem but it seems to be a useless bit of code:

        If Not (Application.VBE.MainWindow.Visible) Then
        Application.VBE.MainWindow.Visible = True
        Application.VBE.MainWindow.Visible = False
        End If

If the window is not visible, it makes it visible then immediately hides it again. Not sure of the utility of that.

 

[Mlspencer08]

Thanks Jeff! I made the updates and it didn't really help much, but I figured out if I just paused the macro and then restarted it, that it picked back up with it's faster pace (25ish files processed/minute). So I threw in this command at the end of the loop:

Application.Wait (Now + TimeValue("0:00:01"))

So basically at the end of each loop it pauses for a second and then picks back up - not sure if that releases something from memory, but I'm about 10 minutes in now and it seems be humming along at it's original pace!

 

[rlv01]

I've noticed that when many files are being opened and closed within a loop it can cause things to slow down over time. A few things can mitigate. One is to use DoEvents procedure at the end of each loop. DoEvents yields execution so that the operating system can process other events. The other is to reduce the number of file open /save / close events to just those needed. Your code is opening your template file once per loop, and it probably does not need to do that if you switch to using the .SaveCopyAs method. See below (not tested).

Sub TextFileLoop()
    '
    ' TextFileLoop Macro
    '
    'Variable Declaration
    Dim sFilePath As String
    Dim sFileName As String
    Dim sFileNameLength As String
    Dim sExcelFileName As String
    Dim WB As Workbook, LoopCnt As Long
    
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    Range("A1").Select
    
    'Specify File Path
    sFilePath = "C:\ProgramData\Kibot Agent\Data"
    
    'Check for back slash
    If Right(sFilePath, 1) <> "\" Then
        sFilePath = sFilePath & "\"
    End If
    
    sFileName = Dir(sFilePath & "*.txt")
    
    Set WB = Workbooks.Open(Filename:= _
    "C:\Users\MattSpencer\Desktop\Personal\Spencer Financial Group\Trading Strategies\Swing Trading\Reversal Candles\Name -.xlsx")
    
    LoopCnt = 0
    Do While Len(sFileName) > 0
        'Set file name length equal to the full length less 4 so it's equal to just the symbol name
        sFileNameLength = Len(sFileName) - 4
        
        'Create variable that will then get used to save the new file name
        sExcelFileName = Left(sFileName, sFileNameLength)
        
        'Open the "Name -" analysis file template
        WB.SaveCopyAs Filename:= _
        "C:\Users\MattSpencer\Desktop\Personal\Spencer Financial Group\Trading Strategies\Swing Trading\Reversal Candles\Analysis Files\Name - " & sExcelFileName & ".xlsx"
        
        sFileName = Dir
        
        LoopCnt = LoopCnt + 1
        If LoopCnt Mod 10 = 0 Then  ' Every 10 loops, this value can be adjusted for best performance.
            DoEvents    ' Allow OS to process events.
        End If
    Loop
    
    WB.Close SaveChanges:=False
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

 

[6StringJazzer]

Your code is opening your template file once per loop, and it probably does not need to do that

That is huge and I'm embarrassed that I didn't notice.