How do we know Macro running Status - Progress Bar Method

[Guna13]

Dear Experts,

I am new to VBA sessions. The current task involves opening over 280+ Excel workbooks and validating a few Sheets data within each workbook, then saving and closing as a new name for the workbooks. It takes about 30 to 35 minutes. We were unable to touch anything in the system until that time.


How do we see this progress status? It would be helpful if someone could guide or help me to create a very simple running progress bar while Macro running this time...Like this format or any your idea welcome...

 

[Guna13]

Ignore the code above, I forgot the total file count. Again, not tested:

Sub Consolidate()
Dim FolderPath As String, Filepath As String, FileName As String
    Dim fso As Object
    Dim objFiles As Object
    Dim obj As Object
    Dim lngFileCount As Long
    Dim BarWidth As Long
    'launch the ProgressBar userform
    frmProgressBar.Show
    'shut off all screen updates

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Sheets("ETB").Rows("2:" & Rows.Count).ClearContents

Set Trg = ThisWorkbook.Sheets("ETB")


FolderPath = "C:\ETB\Target\"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFiles = fso.GetFolder(FolderPath).Files
    lngFileCount = objFiles.Count
  
Filepath = FolderPath & "*.xls*"

'To transfer data from all files you can use the wild-card character *

FileName = Dir(Filepath)

Dim lastRow As Long, lastcolumn As Long

Do While FileName <> ""
    i = i + 1
    With frmProgressBar
        'calculate the bar width for each iteration. The loop number times the overall bar width (200 pixels) divided by the number of loops.
        BarWidth = (i * 200) / lngFileCount
        'set the bar width
        .ProgressBar.Width = BarWidth
        'since the full bar is 200, the percentage is always 1/2 the barwidth.  In case of odd numbers of loops, I make it show as an integer, rather than decimal.
        .lblStatus.Caption = Int(BarWidth / 2) & " % Progress: "
        'Repaint will force updates to the form, reguardless of ScreenUpdating being false.
        .Repaint
    End With

Set es = Workbooks.Open(FolderPath & FileName)

es.Sheets(1).AutoFilterMode = False
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

Range("A2:L" & lastRow).Copy
Trg.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial

es.Close SaveChanges = False

Set es = Nothing
Set File = Nothing



Application.CutCopyMode = False
'On Error GoTo 0
FileName = Dir

Loop

    Set sht = ActiveSheet
    lastRow = sht.Range("A" & Rows.Count).End(xlUp).Row
    Set Rng = sht.Range("A2:A" & lastRow)
 
    Rng.NumberFormat = "@"
    Rng = Application.Text(Rng.Value, "000")

Application.DisplayAlerts = True
Application.ScreenUpdating = True
    'unload the form
    Unload frmProgressBar


End Sub

Hi Sir, I got this error, as per your advice, First i was Created User Form in as you mentioned Names,

the Name of User form is "frmProgressBar", then inside two Label

1. lblProgressBar
2. inside (lblStatus)
3. then Set the Show Modal property of the Userform to False.
then why am getting this error Sir, i attached all four Screen Shot for your quick reference. Kindly support me sir...

 

[Guna13]

Hi Sir still am getting error in this row., as per your advice, First i was created User Form name as frmProgressBar"

Inside two Label
1. lblProgressBar
2. lblStatus
3. the Show Modal property of the UserForm to False.
what is reason to issue. all the screen shot attached for your quick reference.

 

[portews]

where the code stopped should be:

.lblProgressBar.Width = BarWidth