Progress bar with remaining time

[fryes04]

Hi everyone

I've managed to pull together a nice simple progress bar to let users know how long it will take to collate certain data. Example below:

Sub ProgressBar()

frmProgressBar.Show

End Sub

Sub Main()

Application.ScreenUpdating = False

Dim pctCnt As Integer
Dim cnt As Integer
Dim Completed As Single

pctCnt = 1
For cnt = 1 To 100
For a = 1 To 500000
Next
pctCnt = pctCnt + 1
Completed = pctCnt / 100
frmProgressBar.LabelProgress.Width = Completed * frmProgressBar.Width

'START OF CODE

Dim rCell As Range

For Each rCell In Range("A1:A400")

rCell.Select

Next rCell


'END OF CODE

DoEvents
Next
Unload frmProgressBar

Application.ScreenUpdating = True

End Sub

Does anyone know how to show elapsed time remaining....

Thanks in advance

 

[fryes04]

This part is placed in the user form, under the image used to show the progress:

Private Sub UserForm_Activate()
frmProgressBar.LabelProgress.Width = 0
Call Main
End Sub

 

[AMAS]

At the begining of my code I put:

StartTime = Time()

As part of the progress bar update I add:

ProgressBar.RemainingTime.Caption = Format(((StartTime_ab + ((Time() - StartTime) / Counter) * PctTotal) - Time()), "Hh:mm:ss")

 

[fryes04]

I placed the code inside the Module but the frame is only showing current time of day not time remaining

 

[AMAS]

Here's an example from my project. I have stripped it down to the bare essentials. Please feel free to amend for your purposes.

http://dl.dropbox.com/u/9568360/Progressbar%20example.xlsm

 

[fryes04]

ah ok I've got it.

frmProgressBar.RemainingTime.Caption = Format((Time() - StartTime / Completed), "hh:mm:ss")

Thank you for your quick response and your help

 

[fryes04]

Ok maybe I didnt have it lol

Thank you again

great help

 

[Pinaceous]

This is really an excellent code.