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...

 

[portews]

I made a Userform called frmProgressBar with two labels in it. One shows the progress in words ("32% Progress") called lblStatus, the other, lblProgressBar, acts as the bar itself. Set the Show Modal property of the Userform to False. For this bar, the background color is whatever you want it to be (I used blue) that makes it stand out. I made it sunken and put a frame around it to help make it stand out more. Make the bar 200 pixels wide. That will make it wide enough to see and easily divisible by 100 to calculate the percentage. In the code, the width of the bar expands by the Width command each time the code loops thru.

Assuming you're using a loop to open the worksheets, you can use that loop to change the bar width. The generic formula for gauges is gaugeValue=(SelectedValue[loop number]-MinimumValue[100%])*(100/(MaximumValue[100%]-MinimumValue[0%])), so the code might look something like:

Sub Your_Existing_Sub()
Dim BarWidth As Long
'launch the ProgressBar userform
frmProgressBar.Show
'shut off all screen updates
Application.ScreenUpdating = False
'loop through all your worksheets
For i = 1 To Worksheets.Count
    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) / Worksheets.Count
        'set the bar width
        .ProgressBar.Width = BarWidth
        'since the full bar is 200 pixels, 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
    
'do your other stuff here
    
Next
'show the screen
Application.DisplayAlerts = True
'unload the form
Unload frmProgressBar

End Sub

 

[Fluff]

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: How do we know Macro running status - Progress Bar Method
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[Guna13]

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: How do we know Macro running status - Progress Bar Method
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

First and last, I apologize for not posting anywhere other than your site and Chandoo's site. Most of the time, my communication does not reach Community Users clearly. That's why I posted in two places. sometime some guys can understanding my communcation. that's reason..
also, I Wont do next time to do this double posting... Sorry once Again.
Also this above Answer. I am not clear and not achieve this... How can i attached my excel version here...can u please help me. already i installed this .xls2b in Add-Ins

 

[Fluff]

Either follow this link Account details or click your user name at the top right of the forum

 

[Guna13]

I made a Userform called frmProgressBar with two labels in it. One shows the progress in words ("32% Progress") called lblStatus, the other, lblProgressBar, acts as the bar itself. Set the Show Modal property of the Userform to False. For this bar, the background color is whatever you want it to be (I used blue) that makes it stand out. I made it sunken and put a frame around it to help make it stand out more. Make the bar 200 pixels wide. That will make it wide enough to see and easily divisible by 100 to calculate the percentage. In the code, the width of the bar expands by the Width command each time the code loops thru.
View attachment 74588

Assuming you're using a loop to open the worksheets, you can use that loop to change the bar width. The generic formula for gauges is gaugeValue=(SelectedValue[loop number]-MinimumValue[100%])*(100/(MaximumValue[100%]-MinimumValue[0%])), so the code might look something like:

Sub Your_Existing_Sub()
Dim BarWidth As Long
'launch the ProgressBar userform
frmProgressBar.Show
'shut off all screen updates
Application.ScreenUpdating = False
'loop through all your worksheets
For i = 1 To Worksheets.Count
    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) / Worksheets.Count
        'set the bar width
        .ProgressBar.Width = BarWidth
        'since the full bar is 200 pixels, 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
   
'do your other stuff here
   
Next
'show the screen
Application.DisplayAlerts = True
'unload the form
Unload frmProgressBar

End Sub

Hi Sir I got error, while testing time, what i need to change Sir.. here

 

[portews]

This code is not standalone, it was meant to be put in your existing code. Can you post the code you have that does your validation?

 

[Guna13]

This code is not standalone, it was meant to be put in your existing code. Can you post the code you have that does your validation?

very simple code, consolidated more than 300+ Files in Master data purpose. Sir I need progress bar, if you need to change this below code. I am ok for for that...

Sub Consolidate()
Dim FolderPath As String, Filepath As String, FileName As String

Application.DisplayAlerts = False
Application.ScreenUpdating = False

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

Set Trg = ThisWorkbook.Sheets("ETB")


FolderPath = "C:\ETB\Target\"

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 <> ""
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



End Sub

 

[portews]

The reason for the error is you didn't name the userform frmProgressBar to match the code. Change the name on the userform. Since you're putting the percent complete in the frame caption in stead of the label I showed, you'll also need to change .lblStatus.Caption to whatever you named the frame (e.g Frame1.Caption).

My changes are indented, everything else is original.

Try this (not tested):

Sub Consolidate()
Dim FolderPath As String, Filepath As String, FileName As String
    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\"

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) / shtCount
        '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

 

[portews]

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