Excel Progress Bar

[Steven Taylor]

Hi All,

I would really appreciate some help with adding a progress bar
to a vba marco.

The situation is as follows:
1. I am working with Excel 2003 on a Windows XP machine.
2. I have some VBA code that essentially does a comparison of two
data dumps from different systems and then places the results on
a summary page.
3. The code takes about 30 seconds to complete due to the size of the
data dumps.
4. I would like to display a progress bar while the code is runing so that
users can see that the code is working and not stuck in a loop etc.
5. I have found a few examples on the web showing progress bars but
I can't seem to figure out how to increment the progress bar while
it runs through my macro.

The following is a sample of the code being used:

Sub CalculateData()
Dim Total1 As Long
Dim Total2 As Long
Dim x As Long
Dim y As Long
Dim MyTimer As Double

Total1 = 20
Total2 = 1000

For x = 1 To Total1
For y = 1 To Total2
MyTimer = Timer
ProgressBar.TextBox4.Width = (y / Total2) * 200
ProgressBar.Label2.Caption = "Calculating Data: " & y & " of " &
Total2
DoEvents
Next y
ProgressBar.TextBox2.Width = (x / Total1) * 200
ProgressBar.Label1.Caption = "Updating: " & x & " of " & Total1
Next x
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim sht As Object
For Each sht In ActiveWorkbook.Sheets
If sht.Name = "3.Customer Complaints" Then
sht.Activate
Exit Sub
End If
Next sht

Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.AutoFilter
Selection.Sort Key1:=Range("I2"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("F1").Select
Selection.AutoFilter Field:=6, Criteria1:="313"
Selection.AutoFilter Field:=9, Criteria1:="=81*", Operator:=xlAnd
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("2.SAP").Select
Worksheets.Add(After:=Worksheets("2.SAP")).Name = "3.Customer
Complaints"
ActiveSheet.Paste
col = "M"
lastRow = Cells(65536, col).End(xlUp).Row
Cells(lastRow + 1, col).Formula = "=SUM(" & col & "1:" & col & lastRow &
")"
Cells(lastRow + 1, Asc(col) - 65) = "Total:"
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Columns("A:N").EntireColumn.AutoFit
Range("L1").Select
ActiveCell.End(xlDown).Select
Selection.Font.Bold = True
Range("M2").Select
ActiveCell.End(xlDown).Select
Selection.Font.Bold = True
Selection.Style = "Comma"
Selection.NumberFormat = "_(* #,##0.0_);_(* (#,##0.0);_(*
""-""??_);_(@_)"
Selection.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
Range("A1").Select
Sheets("2.SAP").Select
Selection.AutoFilter Field:=6
Selection.AutoFilter Field:=9
Columns("A:N").EntireColumn.AutoFit
Range("A1").Select
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

All comments and suggestions welcome.

Thanks,

Steve

 

[Halim]

Hi Steve,

I guess Progressbar you worte is a name of a userform, is that right?

So on that userform on a toolbar menu you must add ProgressBar class
then paste the object on that form.

the increment of a progressbar can placed in the procedure in the line you
want.

try that... maybe help...

 

[Jan Karel Pieterse]

Hi Steven,

5. I have found a few examples on the web showing progress bars but
I can't seem to figure out how to increment the progress bar while
it runs through my macro.

The progress bar obviously is on a userform, so you need to show the
form too.

Before your loops start, add:

ProgressBar.Show vbModeless

Then when done, don't forget to hide and destroy the form:

ProgressBar.Hide
Unload ProgressBar

Regards,

Jan Karel Pieterse
Excel MVP
http://www.jkp-ads.com
Member of:
Professional Office Developer Association
www.proofficedev.com