Hey, so I recently have been using this in my projects, as I do alot of sql inserts/queries and lots of list formatting where the lists are 50k+ records. I added a ton of comments so hopefully my weird naming scheme will be intuitive for anyone trying to understand it. As it is you can start and end the loop at any row (or any loop values) and it will accurately calculate:
- the record # out of the total the macro is on
- total macro run time
- estimated time left
- percent of records completed
- overall average records/second
- last 10 seconds average records/second
- minutes and seconds automatically formatted for timeleft and run time
- everything rounded and formatted so things like '1.10' dont become '1.1' and cause 'blurring' of the text in the statusbar
I know its rather long for a status bar progress meter... but if anyone can see any improvements or ways to cut it down pls tell me!
Also, dont worry about the length slowing your macro down... with this empty template it only takes 20 seconds for 100,000 loops on my computer.
Code
Sub StatusbarTemplate()
'// define vars
' program specific vars - ADD AS NEEDED - dont change the first 3
Dim upper As Long ' finishing number
Dim lower As Long ' starting number
Dim theloop As Long ' main loop variable
' status calculation vars - DONT CHANGE
Dim Recspersec As Long ' last second records/second
Dim RecspersecArr(1 To 10) As Long ' last 10 seconds records/second array for calculations
Dim i As Integer ' integer for Recspersecarr
Dim Last10secsAverage As Long ' last 10 seconds average records/second
Dim OverallRecspersec As Long ' overall records/second average
Dim CountedRecords As Long ' counted records, reset every seconds
Dim StartingTimer As Variant ' timer to check if 1 second has passed
Dim Timeleft As Variant ' estimated time left to finish
Dim BeginTimer As Variant ' start time for total run time
Dim RunningTime As Variant ' minutes and seconds since start of macro
Dim PercentDone As Variant ' % of records completed
Dim TimeLeft2 As Variant ' needed if minutes and seconds are both displayed
Dim RunningTime2 As Variant ' needed if minutes and seconds are both displayed
Dim TotalRecordCount As Long ' total records processed while macro is running
'// end define vars
'// set vars
'// usually change these:
lower = 1 ' first record row/starting loop value
upper = 100000 ' last record row/ending loop value
'// never change these
StartingTimer = Timer - 0.01 ' offset these by 0.01 so no div/0 error!
BeginTimer = Timer - 0.01 ' offset these by 0.01 so no div/0 error!
CountedRecords = 0 ' always starts at 0, for counting processed records/second
'// end set vars
' // no updating to speed up loop
Application.ScreenUpdating = False
'// main loop for specific task
For theloop = lower To upper
' MAIN LOOP CODE HERE
'// end main loop code
'// start main loop calculations for status's
If StartingTimer + 1 < Timer Then ' sets recspersec and resets countedrecords every second
StartingTimer = Timer ' reset startingtimer
Recspersec = CountedRecords ' set last second recspersec to the counted records
CountedRecords = 0 ' set countedrecords to 0 to begin a new single second count
RecspersecArr(1) = Recspersec ' set first value of array
For i = 10 To 2 Step -1
RecspersecArr(i) = RecspersecArr(i - 1) ' move all array values up one
Next i
'// on the very first loop set all recspersec to the original recspersec to avoid misleading 10sec average
If RecspersecArr(10) = 0 Then
For i = 2 To 10
RecspersecArr(i) = RecspersecArr(i - 1)
Next i
End If
Last10secsAverage = 0 ' reset calculations for last 10 secs average
For i = 1 To 10
Last10secsAverage = Last10secsAverage + RecspersecArr(i) ' populate last10secsaverage
Next i
Last10secsAverage = (Last10secsAverage / 10) ' calculate last10secsaverage
End If
TotalRecordCount = TotalRecordCount + 1 ' overall TOTAL record count for macro
CountedRecords = CountedRecords + 1 ' increment each record processed for every 1 second snapshot
OverallRecspersec = (TotalRecordCount / (Timer - BeginTimer)) ' calc records per seconds
PercentDone = (TotalRecordCount / (upper - lower)) ' calc percent completed
PercentDone = Format(PercentDone, "Percent") ' format percent completed
If OverallRecspersec = 0 Then ' conditional statement to avoid div/0 error 5 lines down!
OverallRecspersec = 1
End If
'// calc all timeleft vars and set string
Timeleft = (((upper - lower) - TotalRecordCount) / OverallRecspersec)
Timeleft = Round(Timeleft, 0)
If Timeleft > 60 Then
Timeleft = Round((Timeleft / 60), 2)
Timeleft = Format(Timeleft, "Standard")
TimeLeft2 = Round((Right(Timeleft, 3) * 60), 0)
Timeleft = Left(Timeleft, Len(Timeleft) - 3)
Timeleft = Timeleft & "m" & " " & TimeLeft2 & "s"
Else
Timeleft = Timeleft & "s"
End If
'// calc all runningtime vars and set string
RunningTime = Round(Timer - BeginTimer, 0)
If RunningTime > 60 Then
RunningTime = Round((RunningTime / 60), 2)
RunningTime = Format(RunningTime, "Standard")
RunningTime2 = Round((Right(RunningTime, 3) * 60), 0)
RunningTime = Left(RunningTime, Len(RunningTime) - 3)
RunningTime = RunningTime & "m" & " " & RunningTime2 & "s"
Else
RunningTime = RunningTime & "s"
End If
'// update the status bar
Application.StatusBar = "[ Record:" & " " & TotalRecordCount & " " & "of" & " " & upper - lower & " ]" & _
" " & " " & "-" & " " & " " & "[ Running:" & " " & RunningTime & "," & " " & " " & "Est. time left:" _
& " " & Timeleft & " ]" & " " & " " & "-" & " " & " " & "[ Percent done:" & " " & PercentDone _
& " ]" & " " & " " & "-" & " " & " " & " " & "[ Ave. speed:" & " " & OverallRecspersec & _
"/sec," & " " & " " & "Last 10 seconds:" & " " & Last10secsAverage & "/sec" & " ]"
'// end of main loop
Next theloop
'// clean up/turn on
Application.StatusBar = False ' status bar to excel controlled
Application.ScreenUpdating = True ' screenupdating to 'on'
Application.CutCopyMode = False ' clear clipboard
End Sub
Cant say how fast that is tho