Progress Bar with Countdown Timer and Elapsed Time

[mctopher]

I have a macro that runs through about 40,000 records which can be quite time consuming. I currently have a status bar that shows the percent of work complete, but I'd like to add something that shows an estimate of how much time is remaining and how much time has passed. Below is the first loop in my code that uses the progress bar. You'll see that I modified the progress bar to include "Label 2" which shows the current record of the total record count, I'd like to add "Label 3" to show something like "2:30 elapsed, 1:15 remaining".

Are there any suggestions for the best way to accomplish this? I'm using Excel 2010 on Windows 7 (64 bit). Thank you!

Sub IdentifyGS()

POData.Activate

For CurrentRow = 2 To LastRow

    Combo = Cells(CurrentRow, ItemNumberColumn).Value & "-" & Len(Cells(CurrentRow, ItemNumberColumn))
    Cells(CurrentRow, 5) = Application.VLookup(Combo, GSList.Columns("A:G"), 7, False)
    
        DoEvents

    PctDone = CurrentRow / LastRow

    With UserForm2
        .FrameProgress.Caption = Format(PctDone, "0%")
        .LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
        .Label2.Caption = ("Record " & Format(CurrentRow - 1, "#,##0") & " of " & Format(LastRow - 1, "#,##0"))
    End With

Next

Unload UserForm2

End Sub

 

[BiocideJ]

I believe this will do what you are requesting. The time remaining will bounce around alot in the beginning (while the PctDone is small), but will get quite accurate once it gets about 33% of the way complete.

Sub IdentifyGS()
POData.Activate
T_Start = Now()
    
For CurrentRow = 2 To LastRow
    Combo = Cells(CurrentRow, ItemNumberColumn).Value & "-" & Len(Cells(CurrentRow, ItemNumberColumn))
    Cells(CurrentRow, 5) = Application.VLookup(Combo, GSList.Columns("A:G"), 7, False)
    
        DoEvents
    PctDone = CurrentRow / LastRow
    T_Elapsed = Round((Now() - T_Start) * 86400)
    T_Remaining = Round(T_Elapsed / PctDone, 3) - T_Elapsed
    
    With UserForm2
        .FrameProgress.Caption = Format(PctDone, "0%")
        .LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
        .Label2.Caption = ("Record " & Format(CurrentRow - 1, "#,##0") & " of " & Format(LastRow - 1, "#,##0"))
        .Label3.Caption = Int(T_Elapsed / 60) & ":" & Right("00" & Int(T_Elapsed Mod 60), 2) & " elapsed, " & Int(T_Remaining / 60) & ":" & Right("00" & Int(T_Remaining Mod 60), 2) & " remaining."
    End With
Next
Unload UserForm2
End Sub

 

[mctopher]

Such a simple solution - I love it! Thanks!

 

[Wulf]

Very similar to what I want to do to a workbook, in regards to a "Reset" command button.

Can the above code be inserted in to the command button functions?

 

[mctopher]

I have a simple user form I set up based on this:

Spreadsheet Page Excel Tips: Displaying A Progress Indicator

Then I ended up simplifying the timer part of the code a little further to the following, not sure how this goes with your Reset Command button, hopefully it helps a bit:

Sub IdentifyGS()

Dim StartTime As Long
Dim RecordsRemaining As Long

POData.Activate

StartTime = Timer

For CurrentRow = 2 To LastRow

    Combo = Cells(CurrentRow, ItemNumberColumn).Value & "-" & Len(Cells(CurrentRow, ItemNumberColumn))
    Cells(CurrentRow, 7) = Application.VLookup(Combo, GSList.Columns("A:G"), 7, False)
    
        DoEvents

    PctDone = CurrentRow / LastRow
    RecordsRemaining = LastRow - CurrentRow
    ElapsedTime = Timer - StartTime
    TimePerRecord = (ElapsedTime / (CurrentRow - 1))
    If TimePerRecord = 0 Then
        TimePerRecord = 0.01
    End If
    TimeRemaining = RecordsRemaining * TimePerRecord

    With UserForm2
        .FrameProgress.Caption = Format(PctDone, "0%")
        .LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
        .Label2.Caption = ("Record " & Format(CurrentRow - 1, "#,##0") & " of " & Format(LastRow - 1, "#,##0"))
        .Label3.Caption = ("Elapsed Time: " & Format(CDate(ElapsedTime / 86400), "hh:mm:ss") & "      Time Remaining: " & Format(CDate(TimeRemaining / 86400), "hh:mm:ss"))
    End With

Next

    POData.Columns("G:G").Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

Unload UserForm2

UserForm1.LabelProgress.Width = 0
UserForm1.Show

End Sub

 

[Wulf]

Nothing I've tried so far has worked with the placement in the command button code. What I have (minus about 750 lines of ranges to reset), is this:

Private Sub CommandButton2_Click()
If MsgBox("Approximately 750 fields are about to be reset to their default formula / value. This will take 1 - 2 minutes. Do you want to continue?", vbQuestion + vbYesNo) = vbNo Then Exit Sub

Range("E8").Formula = "=BG13"
If DateValue(Date) - DateValue(Range("bp10")) >= 7 Then
Range("bp10").Delete

End If
MsgBox ("Your scheduler has been reset")
End Sub

Where in this, would I drop the code you have above?

 

[mctopher]

I'm really not sure on that one... I know with just the progress bar is was a bit of a pain because you had to write things in such a way that one subroutine called the user form, and then that user form had to call another subroutine that actually did the process. It seemed a bit convoluted, but it worked. With the addition of a command button I'm not sure how you could get that to reasonably play in. I'd suggest starting a new thread to see if some of the guru's can offer insight. I'm sure most of them would overlook this thread since there are already some responses, but a new zero-response thread may be your best bet. Best of luck!

 

[BiocideJ]

Nothing I've tried so far has worked with the placement in the command button code. What I have (minus about 750 lines of ranges to reset), is this:

Private Sub CommandButton2_Click()
If MsgBox("Approximately 750 fields are about to be reset to their default formula / value. This will take 1 - 2 minutes. Do you want to continue?", vbQuestion + vbYesNo) = vbNo Then Exit Sub

Range("E8").Formula = "=BG13"
If DateValue(Date) - DateValue(Range("bp10")) >= 7 Then
Range("bp10").Delete

End If
MsgBox ("Your scheduler has been reset")
End Sub

Where in this, would I drop the code you have above?

This code will really only work with loops. From your quote it appears you literally define EVERY cell that is reset?

What cells are you actually resetting via this macro? Is it every cell within a certain range, every third cell in a column, etc?

 

[Wulf]

It is a vast array of cells being reset...literally about 750. Shown above is only ONE (Range("E8").Formula = "=BG13"). Clicking the reset command button starts it off with the:

"Approximately 750 fields are about to be reset to their default formula / value. This will take 1 - 2 minutes. Do you want to continue?"

and ends with the:

"Your scheduler has been reset."

In between there are 750 lines of resets.

Can this be used in such a command button?

 

[BiocideJ]

The way it sounds like you have the code set up now, only with 751 lines of status bar refreshes.

If there is some method to the way the infromation is being updated though, it could potentially be reduced from 750 individual lines of updates to a MUCH more efficient loop which would work splendidly with the time calculation method explained earlier.

For instance, if you are updating every row, every 5th row, etc. Generally, there is always some defined spacing that is being repeated multiple times which you can simplify your code from 800+ lines of code to less than 50.