Still Struggling with Progress Bar Logic

R

ryguy7272

I downloaded a sample of a very cool Progress Bar from this site:
http://www.enhanceddatasystems.com/ED/Pages/ExcelProgressBar.htm


I am trying to determine how to implement it with my code, but can’t seem to
figure it out. How does the Progress Bar figure out how long the entire
process will take? Can someone please take a look at this, and let me know
what I am doing wrong?

For my code to run, just enter consecutive numbers 1 to 82, in AA1:AA82,
then run the macro:
Sub ProgBarDemo()
Dim PB As clsProgBar
Dim nCounter As Integer
Dim lWaitCount As Long

Set PB = New clsProgBar

With PB
.Title = "Enhanced Datasystems Progress Bar"
.Show

For nCounter = 0 To 100

.Progress = nCounter
.Caption1 = "Progress message " & CStr(nCounter)
For lWaitCount = 0 To 1000000

‘My macro begins here:
Application.DisplayAlerts = False
Columns("A:Z").Select
Range("Z1").Activate
Selection.ClearContents
Application.DisplayAlerts = True

Range("A1").Activate

For Each c In Sheets("Import Sheet").Range("AA1:AA82")
lstRw = Cells(Rows.Count, 1).End(xlUp).Row

str1 = "URL;http://www.osha.gov/pls/imis/sic_manual.display?id=" &
c.Value & "&tab=group"
With ActiveSheet.QueryTables.Add(Connection:=str1 _
, Destination:=Range("A" & lstRw + 1))

'.Name = str1
.Name = "sic_manual.display?id=" & c.Value & "&tab=group"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "5"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Next c

Columns("A:B").Select
Range("B1").Activate
Selection.Copy

Range("Y1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Sort Key1:=Range("Z1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Columns("A:B").Select
Selection.ClearContents


Range("X1").Select
ActiveCell.FormulaR1C1 = "=RIGHT(RC[2],LEN(RC[2])-5)"
Range("X1").Select
Selection.AutoFill Destination:=Range("X1:X1004")
Range("X1:X1004").Select
Selection.Copy



Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select

If UserCancelled = True Then GoTo EndRoutine

Next lWaitCount

Next nCounter

EndRoutine:

.Finish

End With

Set PB = Nothing

End Sub



Cordially,
Ryan--
 
F

FSt1

hi.
I download the progress meter file and tried to run it but it crashes on me.
the code seems more complicated that it needs to be but I suppose different
progress meters do it different ways.
but to try and answere your question, the way used most (that i've seen) is
basicly, count up the number of records you are going to process before your
main code starts. then count each loop as your main code runs , then before
the end of each loop, do some math like loop count / total records to get a
percent then update the progress meter. if your code isn't within the loop
then that protion of the code can't be counted. the progress meter bar is
update by adjusting the width of the bar by the percent you calculate at the
end of each loop.

hope this helped
FSt1

ryguy7272 said:
I downloaded a sample of a very cool Progress Bar from this site:
http://www.enhanceddatasystems.com/ED/Pages/ExcelProgressBar.htm


I am trying to determine how to implement it with my code, but can’t seem to
figure it out. How does the Progress Bar figure out how long the entire
process will take? Can someone please take a look at this, and let me know
what I am doing wrong?

For my code to run, just enter consecutive numbers 1 to 82, in AA1:AA82,
then run the macro:
Sub ProgBarDemo()
Dim PB As clsProgBar
Dim nCounter As Integer
Dim lWaitCount As Long

Set PB = New clsProgBar

With PB
.Title = "Enhanced Datasystems Progress Bar"
.Show

For nCounter = 0 To 100

.Progress = nCounter
.Caption1 = "Progress message " & CStr(nCounter)
For lWaitCount = 0 To 1000000

‘My macro begins here:
Application.DisplayAlerts = False
Columns("A:Z").Select
Range("Z1").Activate
Selection.ClearContents
Application.DisplayAlerts = True

Range("A1").Activate

For Each c In Sheets("Import Sheet").Range("AA1:AA82")
lstRw = Cells(Rows.Count, 1).End(xlUp).Row

str1 = "URL;http://www.osha.gov/pls/imis/sic_manual.display?id=" &
c.Value & "&tab=group"
With ActiveSheet.QueryTables.Add(Connection:=str1 _
, Destination:=Range("A" & lstRw + 1))

'.Name = str1
.Name = "sic_manual.display?id=" & c.Value & "&tab=group"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "5"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Next c

Columns("A:B").Select
Range("B1").Activate
Selection.Copy

Range("Y1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Sort Key1:=Range("Z1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Columns("A:B").Select
Selection.ClearContents


Range("X1").Select
ActiveCell.FormulaR1C1 = "=RIGHT(RC[2],LEN(RC[2])-5)"
Range("X1").Select
Selection.AutoFill Destination:=Range("X1:X1004")
Range("X1:X1004").Select
Selection.Copy



Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select

If UserCancelled = True Then GoTo EndRoutine

Next lWaitCount

Next nCounter

EndRoutine:

.Finish

End With

Set PB = Nothing

End Sub



Cordially,
Ryan--
Click to expand...
 
R

ryguy7272

Thanks FSt1, but I’m still not getting it to run. Does anyone have any idea
how to structure the code? Can someone please provide an example?

Cordially,
Ryan---


--
RyGuy


FSt1 said:
hi.
I download the progress meter file and tried to run it but it crashes on me.
the code seems more complicated that it needs to be but I suppose different
progress meters do it different ways.
but to try and answere your question, the way used most (that i've seen) is
basicly, count up the number of records you are going to process before your
main code starts. then count each loop as your main code runs , then before
the end of each loop, do some math like loop count / total records to get a
percent then update the progress meter. if your code isn't within the loop
then that protion of the code can't be counted. the progress meter bar is
update by adjusting the width of the bar by the percent you calculate at the
end of each loop.

hope this helped
FSt1

ryguy7272 said:
I downloaded a sample of a very cool Progress Bar from this site:
http://www.enhanceddatasystems.com/ED/Pages/ExcelProgressBar.htm


I am trying to determine how to implement it with my code, but can’t seem to
figure it out. How does the Progress Bar figure out how long the entire
process will take? Can someone please take a look at this, and let me know
what I am doing wrong?

For my code to run, just enter consecutive numbers 1 to 82, in AA1:AA82,
then run the macro:
Sub ProgBarDemo()
Dim PB As clsProgBar
Dim nCounter As Integer
Dim lWaitCount As Long

Set PB = New clsProgBar

With PB
.Title = "Enhanced Datasystems Progress Bar"
.Show

For nCounter = 0 To 100

.Progress = nCounter
.Caption1 = "Progress message " & CStr(nCounter)
For lWaitCount = 0 To 1000000

‘My macro begins here:
Application.DisplayAlerts = False
Columns("A:Z").Select
Range("Z1").Activate
Selection.ClearContents
Application.DisplayAlerts = True

Range("A1").Activate

For Each c In Sheets("Import Sheet").Range("AA1:AA82")
lstRw = Cells(Rows.Count, 1).End(xlUp).Row

str1 = "URL;http://www.osha.gov/pls/imis/sic_manual.display?id=" &
c.Value & "&tab=group"
With ActiveSheet.QueryTables.Add(Connection:=str1 _
, Destination:=Range("A" & lstRw + 1))

'.Name = str1
.Name = "sic_manual.display?id=" & c.Value & "&tab=group"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "5"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Next c

Columns("A:B").Select
Range("B1").Activate
Selection.Copy

Range("Y1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Sort Key1:=Range("Z1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Columns("A:B").Select
Selection.ClearContents


Range("X1").Select
ActiveCell.FormulaR1C1 = "=RIGHT(RC[2],LEN(RC[2])-5)"
Range("X1").Select
Selection.AutoFill Destination:=Range("X1:X1004")
Range("X1:X1004").Select
Selection.Copy



Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select

If UserCancelled = True Then GoTo EndRoutine

Next lWaitCount

Next nCounter

EndRoutine:

.Finish

End With

Set PB = Nothing

End Sub



Cordially,
Ryan--
Click to expand...
Click to expand...
 
S

Sean

Ryan, you have to tell it.I'll assume you have a Form created or via
the web link (you might have to amend this form as I only show
caption, task and progress) and also a Class module. Place the code
below within your own macro (replace YOUR CODE HERE with whatever).
The 5; 35; 50 is the progress of the bar - you tell it how much it has
progressed

Sub MacroWithPB()

Dim PB As clsProgBar
Set PB = New clsProgBar


With PB


.Title = "Progressing..."
.Caption1 = "Executing, Please wait, this may take a short while"
.Caption2 = "Doing task 1"
.Show
DoEvents


End With


YOUR CODE HERE

PB.Progress = 5
PB.Caption2 = "Doing task 2"

YOUR CODE HERE

PB.Progress = 35
PB.Caption2 = "Doing task 3"

YOUR CODE HERE

PB.Progress = 50
PB.Caption2 = "Doing task 4"

YOUR CODE HERE

PB.Progress = 75
PB.Caption2 = "Doing task 5"

YOUR CODE HERE

PB.Progress = 90
PB.Caption2 = "Doing task 6"

YOUR CODE HERE

PB.Progress = 98
PB.Caption2 = "Doing task 7"

YOUR CODE HERE

PB.Finish

Application.ScreenUpdating = True

End Sub
 
R

ryguy7272

Hummmm, I thought there would be a more automated way. Nevertheless, this is
quite clever.


Thanks Sean!!


Regards,
Ryan---
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Still Struggling with Progress Bar Logic 1
Help, Progress bar with multiple macros 2
Using progress bar with existing loop 1
Updated Modeless Progress Bar Class Available 1
VB Printing problem 0
Need some help 0
Continue running macro until last line of data. 3
Advanced Filter is unstable HELP 0

Top