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.
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