Tuesday, March 28, 2006

Excel: Progress Bar Indicator with VBA

There was a request for an Excel Progress bar with percentage indicator. While I personally don’t understand the need for something like that, I am happy to oblige.

Lets say we have this fictitious scenario. We have a spreadsheet with 65536 numbers in it. I want to go through each number, and in the cell next to it, put an ‘X’ if the number is a prime number. There will be a small form that pops up with a progress bar and percentage indicator while the macro is processing. I am purposely using a inefficient function for determining Prime Numbers so we can have a noticeable delay in the processing in order to demonstrate the Progress Bar indicator.

To start, create a new Excel worksheet. In Cell A1, put in the value of 1. Select all of Column A, go up to “Edit”, “Fill”, and select “Series”. This will fill out all of column a with the numbers 1 – 65536.



I will now create the progress bar itself on a user form. First, I go into the Excel Macro Editor, choose this workbook, go to the “Insert” menu at the top of the screen, and select UserForm. When the component toolbox opens up, I right mouse click on it and choose “Additional Controls”. (Alternatively, I could go up to the “Tools”/”Additional Controls” menu) From the list of components, I select “Microsoft Progress Bar Control 6.0 (SP4)”. I then draw a form with the progress bar and 1 text label, as illustrated below. One thing to be sure of is to set the UserForm1 property of “ShowModal” to false; otherwise the progress bar will display and sit without processing anything else in the script.



And below is the code for the Workbook.

Option Explicit

'Very basic function for finding is a number is prime. Just go through all numbers
'From 2 to 1/2 of the number and divide. If the number is divisible by any of those
'numbers, then it is not a prime number. Check for divisibility by 2 or 3 first to
'Try to speed things up just a little
Function isPrime(n As Long) As Boolean
Dim counter As Long

'ignore the values of 1, 2, and 3 and answer appropriately
If (n = 1) Then Exit Function

If (n = 2) Or (n = 3) Then
isPrime = True
Exit Function
End If

'If number is divisible by 2 or 3, it is not prime
If (n Mod 2 = 0) Then Exit Function
If (n Mod 3 = 0) Then Exit Function

'Go through remaining numbers, if divisible by any of them, it is
'not prime
For counter = 5 To (n / 2)
If (n Mod counter = 0) Then Exit Function
Next

'If we got this far, it must be a prime number
isPrime = True
End Function

Sub ProgressBarDemonstration()
'Used to track the last row in the worksheet
Dim LastRow, counter, percentage As Long

'Get the number of rows in this worksheet by using Excels internal countA function
'I use this instead of looking for blank cells because this has shown itself to be more accurate
If WorksheetFunction.CountA(Cells) > 0 Then
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End If

'If there are no rows, exit out of the function
If LastRow = 0 Then
MsgBox "There are no rows in this worksheet", vbOKOnly
Exit Sub
End If

'Show the user the progress bar
UserForm1.Show

'On error, use the error handler to hide the progress bar
On Error GoTo err_handle

'For all numbers in the worksheet, find out if it is a prime number. If it is,
'put an X next to the number
For counter = 1 To LastRow
If isPrime(Cells(counter, 1).Value) Then
Cells(counter, 2).Value = "X"
End If

'Caluculate the percentage of completion
percentage = (counter / LastRow) * 100

'Update the progress bar and the text indicator
UserForm1.ProgressBar1.Value = percentage
UserForm1.lblPercent = Str(percentage) & "%"

'Do any background events so we don't leave the system unresponsive
DoEvents
Next

'Hide the progress bar when completed
UserForm1.Hide

Exit Sub
'Hide the progress bar in the event of an error
err_handle:
UserForm1.Hide
End Sub

When the code is run, a progress bar will display showing the functions progress.

25 comments:

Anonymous said...

Hi. My name is Bill, and I wanted to thank you for this great tip. I have created a workbook with a macro that takes several seconds and I am fearful that once I release it for general use, fimpatient folks will start hitting keys. With a visible progress meter, I won't be so concerned.

Thanks for the tip!!

Misha said...

Thank you for this loading bar. I find it extremely usefull, since my applciation is in a hedge fund business...my clients do not want to wait, and if they do wait, they need to see the progress...:)

Anonymous said...

So, how would i tweak this to track the progress of multiple subroutines. For example, if I have 1 workbook that contains 10 subroutine. Each subroutine calls a separate workbook and performs a series of code on that workbook, and then closed the workbook and calls the next subroutine.

I'd want the % progress indicator to be based on the # of subroutines

Anonymous said...

I'm the same poster as above. Maybe better yet, to possibily make it easier, tweak it based on counting the # of lines of code in all of the subroutines instead of the # of subroutines

John Ward said...

That is a little tricky to do. If this were .Net, you could use the StackTrace package. Since thats not an option, there are a few options.

For 1, if you have 10 subs, then after each execution you would be roughly 10 percent complete and could update the progress bar accordingly.

If you wanted to, you could also go old school Basic and put in the line numbers in your code. Then, you can figure out how far along in your code execution you are through a little math. Luckily there are programs out there that will add the line numbers automatically.

Anonymous said...

Same Anonymous from above:

So would you be able to show me a working example using the subroutines below? How specifically would the VBA look?

Sub Macro1()
Range("A1").Select
ActiveCell.FormulaR1C1 = "a"
Macro2
End Sub
Sub Macro2()
Range("B1").Select
ActiveCell.FormulaR1C1 = "b"
Macro3
End Sub
Sub Macro3()
Range("C1").Select
ActiveCell.FormulaR1C1 = "c"
Macro4
End Sub
Sub Macro4()
Range("D1").Select
ActiveCell.FormulaR1C1 = "d"
Macro5
End Sub
Sub Macro5()
Range("E1").Select
ActiveCell.FormulaR1C1 = "e"
End Sub

John Ward said...

Anonymous,

Something like this would work... I wrote a small function to demonstrate this, it takes 1 over the number of functions in the total program and multiplies that by the current function number, which will give you the percent complete. Then it updates the progrss bar based on that.

I also included the Sleep function since I needed to slow down the execution to see this work. Note I included the progressbar update before I make the call to MacroX due to the recursive nature of the function calls:

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub CommandButton1_Click()
Macro1
End Sub
Sub updateProgressBar(totalSubs As Integer, subNumber As Integer, ByRef progressBarToUpdate As ProgressBar)
Dim percentComplete As Integer

'Get the percentage of sub routines complete based on the currently executing subroutine
percentComplete = ((1 / totalSubs) * subNumber)

'Update the progressbar with the percent complete
progressBarToUpdate.Value = (100 * percentComplete)
Sleep (3000)
End Sub
Sub Macro1()
Range("A1").Select
ActiveCell.FormulaR1C1 = "a"
updateProgressBar 5, 1, ProgressBar1
Macro2
End Sub
Sub Macro2()
Range("B1").Select
ActiveCell.FormulaR1C1 = "b"
updateProgressBar 5, 2, ProgressBar1
Macro3
End Sub
Sub Macro3()
Range("C1").Select
ActiveCell.FormulaR1C1 = "c"
updateProgressBar 5, 3, ProgressBar1
Macro4
End Sub
Sub Macro4()
Range("D1").Select
ActiveCell.FormulaR1C1 = "d"
updateProgressBar 5, 4, ProgressBar1
Macro5
End Sub
Sub Macro5()
Range("E1").Select
ActiveCell.FormulaR1C1 = "e"
ProgressBar1.Value = (100 / 5) * 1
updateProgressBar 5, 5, ProgressBar1
End Sub

Anonymous said...

I got that to work in your example, but I can't seems to get it to work in my customer made sheet now. Here's the code I'm using:


Sub updateProgressBar(totalSubs As Integer, subNumber As Integer, ByRef progressBarToUpdate As ProgressBar)
Dim percentComplete As Integer

'Get the percentage of sub routines complete based on the currently executing subroutine
percentComplete = ((1 / totalSubs) * subNumber)

'Update the progressbar with the percent complete
progressBarToUpdate.Value = (100 * percentComplete)
End Sub



Sub start_freq()
UserForm1.Show
ActiveWorkbook.RefreshAll
ActiveWorkbook.Save
Workbooks.Add
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\book2.xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Windows("book2.xls").Activate
Sheets("Tab Definitions").Select
updateProgressBar 5, 1, ProgressBar

(I have more after this, but I cut it off here at where the error occurs)

I get the following error at the last line above:

Compile error:
ByRef argument type mismatch


I can't see the mismatch, but maybe I am just going blind.

John Ward said...

updateProgressBar 5, 1, ProgressBar

In that statement, the use of ProgressBar should be disallowed since ProgressBar is a type. You need to pass in the name of the Pogressbar Variable as it is named on your form, such as pbOverallProgress, or pbProgress.

Anonymous said...

Still the same error:

The Progress Bar is named pbBar in the Form (UserForm1 is it's name)




Sub updateProgressBar(totalSubs As Integer, subNumber As Integer, ByRef progressBartoUpdate As ProgressBar)
Dim percentComplete As Integer
Dim pbBar As ProgressBar

'Get the percentage of sub routines complete based on the currently executing subroutine
percentComplete = ((1 / totalSubs) * subNumber)

'Update the progressbar with the percent complete
progressBartoUpdate.Value = (100 * percentComplete)
End Sub



Sub start_freq()
'UserForm1.Show
ActiveWorkbook.RefreshAll
ActiveWorkbook.Save
Workbooks.Add
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\book2.xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Windows("book2.xls").Activate
Sheets("Tab Definitions").Select
updateProgressBar 5, 1, pbBar

John Ward said...

Whoops.... my bad, I overlooked something there. In the function updateProgressBar, percentComplete will always get assigned the value of 0 since ((1 / totalSubs) * subNumber) will always return a real number. Integer casts will automatically cut off the remaining decimals. So to fix your function you would need to update percentComplete to read like so:

Sub updateProgressBar(totalSubs As Integer, subNumber As Integer, ByRef progressBartoUpdate As ProgressBar)
Dim percentComplete As Single

'Get the percentage of sub routines complete based on the currently executing subroutine
percentComplete = ((1 / totalSubs) * subNumber)

'Update the progressbar with the percent complete
progressBartoUpdate.Value = percentComplete * 100
End Sub

I wasn't paying attention to that when I posted it originally. Make sure you are using your code in the same module as UserForm1. Drop the statement dim pbBar as progressBar in updateProgressBar since it is not necessary. I changed start_freq in the below example since I don't have the books2.xls file you are referencing, but it should go something like this:

Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const LOOP_MAX As Integer = 10

Sub updateProgressBar(totalSubs As Integer, subNumber As Integer, ByRef progressBartoUpdate As ProgressBar)
Dim percentComplete As Single

'Get the percentage of sub routines complete based on the currently executing subroutine
percentComplete = ((1 / totalSubs) * subNumber)

'Update the progressbar with the percent complete
progressBartoUpdate.Value = percentComplete * 100
End Sub

Sub start_freq()
Dim x As Integer

For x = 1 To LOOP_MAX
updateProgressBar LOOP_MAX, x, pbBar
Sleep (900)
DoEvents
Next
End Sub

Private Sub CommandButton1_Click()
start_freq
End Sub

Anonymous said...

Awesome!!! Everything works perfect now.

While we're at it ( :-) ) , do you happen to know if there is a way, while a series of Subroutines are running one right after the other, to Stop the Macro running these Subroutines and then Start them back up - both by the click of a button.

John Ward said...

Anonymous,

I answered that question in a seperate post: http://digiassn.blogspot.com/2006/11/vb-start-and-stop-macro-execution-with.html

Anonymous said...

Man you are just absolutely awesome. Got my processes working 99% flawlessly now.

The only 1% I am left to figure out is how to keep my progress bar active the entire time all of the other subroutine/macros are running. If I click off of the workbook that contains the subroutines and userform, and then try to click back on it to activate it while the other subroutines are running then I can't see the progress (one of those excel things).

So I was wondering if there was a way to have excel call up MSAccess and have the Userform/Progress Bar in MSAccess and be able to have it talk back and forth with Excel as Excel is running the subroutines/macros so that the MSAccess Progress Bar (which I have in Excel currently) can update.

Possible?

Prasad Dethe said...

Hi John,

I am trying to use progressbar code in my application. I have read all comments in this blog and followed every step but still get an error message "Comile Error: User-defined type not defined" and I think my VBA is accepting "progressbar" as user-defined type.

Anonymous said...

Prasad,

Possibly, change ProgressBar to something like myProgressBar. Int he version I used int eh above example (Excell 2000), it wasnt as picky. That may not be the case for you. If you want, post your code and I will take a look.

John

Anonymous said...

Hi,

I have a similar question. I have a worksheet, where I hide/show params in a pivot table, which in turn re-calculates the whole worksheet, which takes about 3-4 minutes. How do I show the progress bar during that recalc time? Thanks.

Anonymous said...

Thanks, this is a very helpful post

Anonymous said...

BIG THANX!!!!!!!!

BvS said...

It's so simpel (if you got the right help)
Thx

Michael Krause said...

ShowModal = "False", brilliant, that statement was apparently too hard to include in any of the VBA books. Thanks much.

Anonymous said...

updateProgressBar LOOP_MAX, x, UserForm1.pbBar

Anonymous said...

updateProgressBar LOOP_MAX, x, UserForm1.pbBar

Shadow said...

Thanks for this helpful post. This function is very important for any macros that have a lengthy runtime.

essameng said...

Thank you. That is really useful.