VBA Process Timer

_vba_util_timer.readme

----------------------------------
VBA Process Timer Utility
----------------------------------
wrote this years back when I was doing a lot of vba work.
basically creates a process timer stack to add / pop timers
from, making it easy to add timers to code and track multiple
ones to see how multiple parts of a process are running.
.. test for speed, see where bottleneck is, etc.
You can also make it return the time as a string,
so you can use it to quickly create log files of code runs.

vba_util_timer.bas

'----------------------------------
' process timer utility
'----------------------------------

Option Explicit

'----------------------------------

Dim varTimer(254, 2) As Variant         ' proc_time array to track elapsed process times (max 255 timers)
Dim bytTimerRow As Byte                 ' proc_time row we're working with


Public Function Proc_Time(s As String, Optional booReturnVal As Boolean = False) As String
' a process timer stacker that will add time/timer val's to stack when called
' first time then return elapsed time in "hh:mm:ss (milliseconds)" format when
' called again for same proc.
'
' EG: Proc_Time "MyProcess"
'     if MyProcess is not being tracked yet, then it's added to the stack along with current time/timer
'     when called again for MyProcess, Proc_Time will return elapsed time for it, and pop it from stack
'
' .. so, you'd use it like such...
'
' Proc_Time "MyTimer1"     ' kicks off timer (adds it to timer stack)
' (code you're timing)
' Proc_Time "MyTimer1"     ' pops timer and shows time in Debug window
'
' Since you can tell it to optinally return the time as a string,
' you can quickly make log files with it, too, or show users a msgbox
' to let them know how long some action took.
'
' EG:
'
' dim msg as string
' Proc_Time "MyTimer1"                ' kicks off timer (adds it to timer stack)
' (code you're timing)
' msg = Proc_Time("MyTimer1", True)   ' pops timer and returns time as String
' msg = "Code took " & msg & " to run." ' create string to return to user or log
'
' mostly use this for testing VBA code speed, but was also useful to ad-hoc
' test SQL code embedded in VBA via ADODB or such. EG: you'd start a timer
' before pushing a SQL statement to a DBA, then pop the timer once the statement
' returned results to get a ballpark figure of how long the SQL was taking to
' process.
  
    ' search the stack for the proc we're timing
    For bytTimerRow = 0 To UBound(varTimer)
        
        ' if we find it...
        If varTimer(bytTimerRow, 0) = s Then
        
            ' format return text ... "hh:mm:ss  (0.00 seconds)"
            s = Format(VBA.Time - varTimer(bytTimerRow, 1), "hh:mm:ss") & "  (" & _
                Format(VBA.Timer - varTimer(bytTimerRow, 2), "0.000") & " seconds)"

            ' debug feedback for code timing
            Debug.Print s & " ... " & varTimer(bytTimerRow, 0)

                ' if we need to return the value, then do so, otherwise skip it
                ' this lets us use the function as a basic timer for debugging
                ' or to return timer values for user feedback in msgbox's
                If booReturnVal Then
                    Proc_Time = s
                End If
            
            Proc_Time_Entry "", #1/1/1900#, 0   ' pop entry from stack
            Exit Function                       ' found it, so exit early
        End If
    Next


    ' if not found, then add to stack
    For bytTimerRow = 0 To UBound(varTimer)
        If varTimer(bytTimerRow, 0) = "" Then       ' add to first blank row we find
'            Debug.Print s & " ... starting timer"
            Proc_Time_Entry s, VBA.Time, VBA.Timer  ' add entry to stack
            Exit Function                           ' found our row, so exit early
        End If
    Next

End Function

'---------------------------------------

Public Sub Proc_Time_Clear()
' reset timer stack by wiping out all values

    For bytTimerRow = 0 To UBound(varTimer)
        Proc_Time_Entry "", #1/1/1900#, 0
    Next

    Debug.Print "Proc_Time ... cleared"
    
End Sub

'---------------------------------------

Sub Proc_Time_Entry(strProc As String, strTime As Date, strTimer As Single)
' updates bytTimerRow with values passed to it
' used for adding/clearing entries from varTimer

    varTimer(bytTimerRow, 0) = strProc  ' string ... processs name we're timing
    varTimer(bytTimerRow, 1) = strTime  ' date/time ... for hh:mm:ss calculation
    varTimer(bytTimerRow, 2) = strTimer ' timer/single ... for milliseconds calculation

End Sub

vba_util_timer_debug.bas

'---------------------------------------
' testing / debug
'---------------------------------------

Option Explicit

'---------------------------------------

Sub Proc_Time_Test()
' migrating code from earlier version of VBA I developed it in
' caused blow-ups in later version of Excel. So, use-case to
' iron out bugs.
'
' Turns out Time works fine, but Timer blows up.. need to
' VBA.Time & VBA.Timer them to qualify them which makes
' Timer work now. Going to qualify more things just to be
' safe (eg: Excel.Worksheet, VBA.Now).
    
    Proc_Time "Test 1"  ' add timer
    Proc_Time "Test 1"  ' pop timer

End Sub

Sub Proc_Time_Test2()
' test time gaps

    ' add timers
    Proc_Time "Test 1"
    Proc_Time "Test 2"
    Proc_Time "Test 3"

    ' wait 1 sec between timers and pop them from stack
    With Application
        .Wait (VBA.Now + TimeValue("0:00:01"))
        Proc_Time "Test 1"
        .Wait (VBA.Now + TimeValue("0:00:01"))
        Proc_Time "Test 2"
        .Wait (VBA.Now + TimeValue("0:00:01"))
        Proc_Time "Test 3"
    End With 'Application

End Sub