I can't take credit for this code...I found it on the internet at this address: http://j-walk.com/ss/excel/tips/tip34.htm
KUDO's to the original developer, who ever it is...
-----------------------------------
Click HERE to download an example
A common question among Excel developers is, How can I use a custom dialog
box to display the progress of a lengthy macro? This document describes
how to create an attractive progress indicator with minimal effort.
Creating the UserFormFollow the steps below to create the progress indicator UserForm.
- Insert a new UserForm and change its Caption to Progress.
- Add a Frame control and name it FrameProgress.
- Add a Label control inside of the Frame and name it LabelProgress.
- Remove the Label's caption, and make its background color red.
- Add another label (option) to describe what's going on.
- Adjust the form and controls so they look like this:
Creating the Event-handler subroutines
The trick here involves running a subroutine automatically when the dialog box is displayed. Since the Initialize event occurs before the dialog box is actually show, you must use the Activate event. Insert the following subroutine in the Code window for the UserForm. This subroutine simply calls the Main subroutine (stored in a VBA module) when the UserForm is displayed.
CODE:
-----------------------------------
Private Sub UserForm_activate()
Call Main
End Sub
-----------------------------------
The Main subroutine is listed below. This demo routine simply inserts random numbers into the active worksheet. As it does so, it changes the width of the Label control and displays the percent completed in the Frame's caption. You will, of course, substitute your own subroutine. And you'll need to figure out how to determine the progress complete.
-----------------------------------
CODE Continued:
Sub Main()
' Inserts random numbers on the active worksheet
Dim Counter As Integer
Dim RowMax As Integer, ColMax As Integer
Dim r As Integer, c As Integer
Dim PctDone As Single
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
Cells.Clear
Application.ScreenUpdating = False
Counter = 1
RowMax = 100
ColMax = 25
For r = 1 To RowMax
For c = 1 To ColMax
Cells(r, c) = Int(Rnd * 1000)
Counter = Counter + 1
Next c
PctDone = Counter / (RowMax * ColMax)
With UserForm1
.FrameProgress.Caption = Format(PctDone, "0%")
.LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
End With
' The DoEvents statement is responsible for the form updating
DoEvents
Next r
Unload UserForm1
End Sub
-----------------------------------
Creating the start-up subroutine
All that's missing is a subroutine to display the dialog box. Enter the following subroutine in a VBA module.
-----------------------------------
CODE Continued:
Sub ShowDialog()
UserForm1.LabelProgress.Width = 0
UserForm1.Show
End Sub
-----------------------------------
How it works
When you execute the ShowDialog subroutine, the Label object's width is set to 0. Then the Show method of the UserForm1 object displays the dialog box. When the dialog box is displayed, its Activate event is triggered, which executes the Main subroutine. The Main subroutine
periodically updates the width of the Label. Notice the DoEvents statement. Without this statement, changes to the Label are not visible. Before the subroutine ends, the last statement unloads the UserForm object.
Caveat
This is definitely a slick technique, but you should be aware that it may slow down your macro a bit due to the extra overhead of updating the progress indicator. In many cases, however, it is not even noticeable.
