LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2
Default Excel Progress Bar

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


 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Excel progress bar MeTheITGuy Charts and Charting in Excel 5 March 28th 07 10:51 PM
NEED Help - How to capture the Event's progress in Progress Bar Sriram Excel Programming 6 August 22nd 06 12:04 PM
Excel Status Progress Bar Ai Excel Programming 2 May 28th 04 01:41 PM
Excel VBA Progress bar on a userform Bo_[_2_] Excel Programming 3 May 28th 04 01:00 PM
Excel and Progress Fred Smith Excel Programming 3 April 28th 04 05:23 PM


All times are GMT +1. The time now is 05:23 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"