Loop through workbooks in a folder, with progress bar.

Hello everyone,

The code below loops through multiple files in folder. I would like to write code which displays progress bar with percentage of files processed or progress of this macro in the Status Bar, whichever is easier for you. Thank you in advance for your help and suggestions.

Dilshod

Sub BuySellSignals()

Dim wb As Workbook, ws As Worksheet
Workbooks("MasterFile - Copy.xlsm").Worksheets("MasterSheet").Cells.Clear
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder("C:\VBA\")
Set DestSh = Workbooks("MasterFile - Copy.xlsm").Worksheets("MasterSheet")

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayStatusBar = False
Application.DisplayAlerts = False

For Each wbFile In fldr.Files
    If fso.GetExtensionName(wbFile.Name) = "csv" Then
Set wb = Workbooks.Open(wbFile.Path)

            Worksheets(1).Activate
            Range("I1").Value = "V/SMA10"
            Columns("I:I").NumberFormat = "General"
            Range("I2").FormulaR1C1 = "=AVERAGE(RC[-1]:R[9]C[-1])"
            Range("I2").AutoFill Destination:=Range("I2:I1500")
            
            Range("J1").Value = "Vol/Change%"
            Columns("J:J").NumberFormat = "0.00%"
            Range("J2").FormulaR1C1 = "=(RC[-2]-RC[-1])/RC[-1]"
            Range("J2").AutoFill Destination:=Range("J2:J1500")
            
            Range("K1").Value = "SMA10"
            Columns("K:K").NumberFormat = "0.00$"
            Range("K2").FormulaR1C1 = "=AVERAGE(RC[-4]:R[9]C[-4])"
            Range("K2").AutoFill Destination:=Range("K2:K1500")

            Range("L1").Value = "SMA30"
            Columns("L:L").NumberFormat = "0.00$"
            Range("L2").FormulaR1C1 = "=AVERAGE(RC[-5]:R[29]C[-5])"
            Range("L2").AutoFill Destination:=Range("L2:L1500")

            Range("M1").Value = "BUY/SELL SMA10 CROSSOVER"
            Range("M2").FormulaR1C1 = "=IF(AND(RC[-2]>RC[-1],R[1]C[-2]<R[1]C[-1],RC[-1]>R[1]C[-1]),""BUY"",IF(AND(RC[-7]<RC[-4],R[1]C[-7]>R[1]C[-4]),""SELL"",""""))"
            Range("M2").AutoFill Destination:=Range("M2:M120")
            
            Range("O1").Value = "Close/Change%"
            Columns("O:O").NumberFormat = "0.00%"
            Range("O2").FormulaR1C1 = "=(RC[-8]-R[1]C[-8])/R[1]C[-8]"
            Range("O2").AutoFill Destination:=Range("O2:O1500")
 
            ActiveSheet.Columns.AutoFit
            
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            Application.DisplayStatusBar = False
            Application.DisplayAlerts = False
            
            For i = 2 To 2
                If Worksheets(1).Cells(i, 13).Value = "BUY" Then
                    ActiveWorkbook.Worksheets(1).Rows(i).Copy
                    DestSh.Activate
                    DestRowNumber = DestSh.Cells(Rows.Count, 1).End(xlUp).Row
                    With DestSh.Cells(DestRowNumber + 1, 1)
                        .PasteSpecial xlPasteValues
                        .PasteSpecial xlPasteFormats
                        Application.CutCopyMode = False
                    End With
                    
                End If
            Next
            
            DestSh.Columns.AutoFit

        wb.Close True
    End If
Next wbFile

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayStatusBar = True
Application.DisplayAlerts = True
Application.CutCopyMode = False

End Sub

Quote from rollis13

Add at the beginning at the end of your macro the lines marked: '<= added and choose what to do with the line marked:

Code

'<= do not use or change to True

Code

Sub BuySellSignals()
    Dim wb     As Workbook, ws As Worksheet
    Workbooks("MasterFile - Copy.xlsm").Worksheets("MasterSheet").Cells.Clear
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fldr = fso.GetFolder("C:\VBA\")
    Set DestSh = Workbooks("MasterFile - Copy.xlsm").Worksheets("MasterSheet")
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    'Application.DisplayStatusBar = False          '<= do not use or change to True
    Application.DisplayAlerts = False
    Dim counter As Long                           '<= added
    Dim numFiles As Long                          '<= added
    numFiles = fldr.Files.Count                   '<= added
    For Each wbFile In fldr.Files
        Application.StatusBar = "Processing: " & Format(counter / numFiles, "0.0%") & " completed" '<= added
        If fso.GetExtensionName(wbFile.Name) = "csv" Then
            Set wb = Workbooks.Open(wbFile.Path)
'
'
' all the rest of your macro            
'
'
            wb.Close True
        End If
        counter = counter + 1                     '<= added
    Next wbFile
    Application.StatusBar = False                 '<= added
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayStatusBar = True
    Application.DisplayAlerts = True
    Application.CutCopyMode = False
    
End Sub

Display More

Hello Rollis13.

Thanks a lot for your code. It is working perfectly well. The only problem is that when the macros is running status bar becomes dark green, so the black font with dark green background I could hardly able to see. Of course it is not your fault. I was wandering is there any chance to modify code so that it would display progress bar with percentage, so that I could adjust size and color of the font and background to my vision? Thank you in advance.

Dilshod

Quote from rollis13

There's no way to change color of the Status Bar using Excel, so, since I don't know why your Status Bar is green while mine is gray, I suggest you look around for a progress bar to fit your project, something like this: LINK

Thanks very much for suggestion. I will try.

Quote from Carim

Hi,

If you feel like digging a bit further in order to configure the Excel status bar with API :

https://www.tek-tips.com/viewthread.cfm?qid=1075291

Hope this will help

Display More

Thank you for advice. I'm just beginner in coding, the info in the link is too complicated for me. I found easier way to change color of the status bar: File/Options/General/Office Theme - White - Status bar remains green, but font color changes to white and that makes it better visible.

Thanks for you help anyway.

Dilshod