Any suggestions on how to implement a progress bar with this userform code?

[msb1977]

Hi all

Below is the code for one of my userforms. After reading about progress bars/indicators, I realized I still have no clue how to implement one in this userform because all of the examples I have seen are based on random number generators such as:

Excel Tips From John Walkenbach: Displaying A Progress Indicator
or
Progress Indicator in Excel VBA - Easy Excel Macros
or
Examples from Andy Pope's page

So, I guess what I am mainly confused about is how to set it up to run with my code instead of a random number generator.

The below code itself does not take long to run, but it can take several minutes to open the 30MB file off of a slow sharepoint server. I want the progress bar/indicator so the user knows the code is still running. I don't need anything fancy, just something that looks professional.

In short, what the code does is prompt the user to make sure the latest file is available with a link, give the option to continue/cancel based on the data availability, open a file off of the server, filters that file based on multiple criteria, copies/pastes the filtered data to my workbook, and then re-applies formulas in the table/deletes potentially excess table rows.

Any suggestions? Your help is, as always, much appreciated.

Oh and if it matters, I am using Excel 2010. I think we may be upgrading to 2013 soon.

' Retrieve, Filter, Copy, and Paste Obligation Status Report to Budget File Userform

Private Sub cmdNo_Click()

Unload Me

Dim wbBudget  As Workbook
Dim Message   As String

Set wbBudget = ActiveWorkbook
Message = msgbox("Action cancelled. You will be returned to the Tool Engine page.", vbOKOnly, "Action Cancelled")
wbBudget.Sheets("Tool Engine").Select
wbBudget.Sheets("Tool Engine").Range("A1").Select
wbBudget.Sheets("Tool Engine").Range("A1").Activate

End Sub

Private Sub cmdYes_Click()

Unload Me

'Define Variables
Dim wbOSR               As Workbook   'Obligation_Status_Report workbook located in zzz Daily Reports
Dim wbBudget            As Workbook   'Budget & Execution Tool workbook
Dim Criteria_Proj()     As Variant    'Defines project criteria for filtering
Dim Criteria_Task()     As Variant    'Defines task criteria for filtering
Dim rngProj             As Range      'Sets range of projects for filtering
Dim rngTask             As Range      'Sets range of tasks for filtering
Dim LastRow             As Long       'Last row of data on OSR DAI worksheet
Dim LastDate            As Date       'Last modified date of Obligation_Status_Report workbook
Dim CurrentYear         As Range      'Sets year of data to filter
Dim screenUpdateState   As String     'Saves current state of screen updating (enabled/disabled)
Dim statusBarState      As String     'Saves current state of the status bar (enabled/disabled)
Dim calcState           As String     'Saves current state of the calculations (automatic/manual)
Dim eventsState         As String     'Saves curent state of envents (enabled/disabled)

'Save the current state of excel settings
screenUpdateState = Application.ScreenUpdating
statusBarState = Application.DisplayStatusBar
calcState = Application.Calculation
eventsState = Application.EnableEvents

'Turn off excel functionality to improve performance
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

'Delete old data from OSR DAI worksheet and turn off filter
Set wbBudget = ActiveWorkbook
If wbBudget.Sheets("OSR DAI").ListObjects("TableOSRDAI").ShowAutoFilter = True Then
   wbBudget.Sheets("OSR DAI").ListObjects("TableOSRDAI").AutoFilter.ShowAllData
End If
wbBudget.Sheets("OSR DAI").Range("TableOSRDAI[Expenditure Organization]:TableOSRDAI[Closed Date]").Clear
   
'Open and Retrieve Date of the Obligation Status Report from the server
Set wbOSR = Workbooks.Open("https://zzz\Obligation_Status_Report.xlsx")
wbOSR.Activate
LastDate = wbOSR.BuiltinDocumentProperties("Last Save Time").Value
wbBudget.Sheets("Tool Engine").Range("Date_OSR").Value = LastDate

'Filter Obligation Status Report for the fiscal year
Set CurrentYear = wbBudget.Sheets("Tool Engine").Range("Current_Year")
wbOSR.Sheets(1).Range("Table1").AutoFilter Field:=2, Criteria1:=CurrentYear
   
'Set lookup data criteria for filtering projects
With wbBudget.Sheets("Lists_ProjTaskLookup")
   Set rngProj = .ListObjects("TableGMOPRProjTaskList").ListColumns("Project Name") _
                 .Range.SpecialCells(xlCellTypeConstants)
End With
Criteria_Proj = Application.Transpose(rngProj.Value)

'Filter Obligation Status Report for projects
wbOSR.Sheets(1).Range("Table1").AutoFilter Field:=6, Criteria1:=Criteria_Proj, Operator:=xlFilterValues

'Set lookup data criteria for filtering tasks
With wbBudget.Sheets("Lists_ProjTaskLookup")
   Set rngTask = .ListObjects("TableGMOPRProjTaskList").ListColumns("Task Name") _
                 .Range.SpecialCells(xlCellTypeConstants)
End With
Criteria_Task = Application.Transpose(rngTask.Value)

'Filter Obligation Status Report for tasks
wbOSR.Sheets(1).Range("Table1").AutoFilter Field:=7, Criteria1:=Criteria_Task, Operator:=xlFilterValues
   
'Copy and Paste the specified range from the OSR workbook to the OSR DAI worksheet
Application.CutCopyMode = False
wbOSR.Sheets(1).Range("Table1").SpecialCells(xlCellTypeVisible).Copy
wbBudget.Sheets("OSR DAI").Range("TableOSRDAI[Expenditure Organization]").PasteSpecial xlPasteAll
Application.CutCopyMode = False
wbOSR.Close SaveChanges:=False
   
'Activate Budget Workbook again and turn on filter
wbBudget.Activate
wbBudget.Sheets("OSR DAI").Select
wbBudget.Sheets("OSR DAI").Range("A1").Select
wbBudget.Sheets("OSR DAI").Range("A1").Activate
If wbBudget.Sheets("OSR DAI").ListObjects("TableOSRDAI").ShowAutoFilter = False Then
   wbBudget.Sheets("OSR DAI").ListObjects("TableOSRDAI").ShowAutoFilter = True
End If
  
'Delete blank table rows
On Error Resume Next
wbBudget.Sheets("OSR DAI").Range("TableOSRDAI[Expenditure Organization]").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
On Error GoTo 0

'Restore excel settings to original state
Application.ScreenUpdating = screenUpdateState
Application.DisplayStatusBar = statusBarState
Application.Calculation = calcState
Application.EnableEvents = eventsState

formOSRCompletion.Show

'Clear Memory
Set wbOSR = Nothing
Set wbBudget = Nothing
End Sub

Private Sub lblLink_Click()
ActiveWorkbook.FollowHyperlink Address:="https://zzz/dailyreports/default.aspx"
End Sub

 

[msb1977]

Any ideas? Thanks!

 

[msb1977]

What about adding scrollable text that says something like "Excel VBA code running. Please wait." from the point that the "Yes" command button is clicked to the conclusion of the code?

 

[msb1977]

One more try...any suggestions? I am open to any ideas.

 

[RoryA]

If the main delay is in opening the file, a progress bar won't be any use, since you won't be able to update it at that point.

You could put up a small modeless userform with a simple message on it, then unload that at the end, or you could even just put a message in the status bar.

 

[msb1977]

That will work. The users are rather impatient and if it doesn't finish in 5 secs or less they think something is wrong. Thanks.