Progress bar for consolidation loop in VBA - vba

Question

I have this consolidation macro which opens, copies and pastes data from one sheet of several workbooks onto a master sheet where such data as well as workbooks maybe in the thousands. Overall this process will take anywhere from 30mins to an hour and I thought a progress bar would help.
I got the code i used for the consolidation part here at stackoverflow. It was somebody with a similar issue, however, the progress bar code i got somewhere else. I had to jury-rig the code of sorts to fit it for my needs.. The examples online uses a for next loop code for the progress bar which mine doesn't.
i tried running my code but the progress bar doesn't update.. T_T
can somebody help me with what's wrong with my code?
Any help on this is very much appreciated.. thanks..
Sub OpeningFiles()
Dim SelectedFiles As FileDialog
Dim NumFiles As Long, FileIndex As Long
Dim TargetBook As Workbook
Dim sName, sName2, sName3 As Range
Dim pctCompl As Single
Set sName = ThisWorkbook.Sheets("Sheet1").Range("j1")
Set SelectedFiles = Application.FileDialog(msoFileDialogOpen)
With SelectedFiles
.AllowMultiSelect = True
.Title = "Pick the files you'd like to consolidate:"
.ButtonName = ""
.Filters.Clear
.Filters.Add ".xlsx files", "*.xlsx"
.Show
End With
If SelectedFiles.SelectedItems.Count = 0 Then Exit Sub
NumFiles = SelectedFiles.SelectedItems.Count
For FileIndex = 1 To NumFiles
Set TargetBook = Workbooks.Open(SelectedFiles.SelectedItems(FileIndex), ReadOnly:=True)
Application.DisplayAlerts = False
ActiveWorkbook.Activate
Sheets(sName).Activate
On Error GoTo 0
Range("d11:j11").Select
Range(Selection, Selection.End(xlDown)).Copy
ThisWorkbook.Sheets("Sheet1").Activate
Range("b2").Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
ActiveCell.PasteSpecial Paste:=xlPasteValues
ThisWorkbook.Application.CutCopyMode = False
TargetBook.Close SaveChanges:=False
Next FileIndex
progress pctCompl
MsgBox ("Consolidation complete!")
End Sub
Sub progress(pctCompl As Single)
UserForm1.Text.Caption = pctCompl & "% Completed"
UserForm1.Bar.Width = pctCompl * 2
DoEvents
End Sub
Sub ShowProgress()
UserForm1.Show
End Sub
Addendum:
This code
Sheets(sName).activate
selects the sheetname of the opened file wherein it is always a number from 1-30. Right now, I have to indicate that number one at a time. Is there a way to do it like 3 or 7 times? like a loop? e.g 1-7 or 25-27.. It is always ascending so i thought a code like the one below will work? Thoughts?
For sName = sNameStart To sNameEnd Step 1
Sheets(sName).Activate
On Error GoTo 0
Range("d11:j11").Select
Range(Selection, Selection.End(xlDown)).Copy
ThisWorkbook.Sheets("Sheet1").Activate
Range("b2").Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
ActiveCell.PasteSpecial Paste:=xlPasteValues
ActiveWorkbook.Activate
Next sName
where sName is the sheet name, sNameStart is the start sheet and sNameEnd is the end sheet.
However, i get this error when I start this code.. Help?

Answer 1

You need to move your call to progress pctCompl inside your loop.
The code you posted doesn't call progress pctCompl until after Next FileIndex
ThisWorkbook.Application.CutCopyMode = False
TargetBook.Close SaveChanges:=False
Next FileIndex
progress pctCompl
MsgBox ("Consolidation complete!")
Replace it with this:
ThisWorkbook.Application.CutCopyMode = False
TargetBook.Close SaveChanges:=False
'insert your command here
progress pctCompl
Next FileIndex
MsgBox ("Consolidation complete!")

Answer 2

If you need something more precise than progress bar try putting:
Application.StatusBar = "File " & FileIndex & " of " & NumFiles
somewhere within For..Next loop, I like this because it is more verbose than just progress bar.
And remember to put
Application.StatusBar = False
After your loop to restore standard status bar.