Dev Corner:

Code Snippets and Dev Modules

This section contains lots of useful tools for Office VBA developers – there’s lots of VBA snippets to cut and paste into your own projects, plus some useful modules and forms that you may want to add to your own projects. Enjoy!

VBA Code Timer | Class Module

When you are developing VBA applications, it’s not unusual to find certain sections of code that seem to run more slowly than expected, but often it can be difficult to exactly pinpoint where the bottleneck is occurring.

In such instances, placing timers in the code to see how long different sections take to run is a great way of narrowing down where the code is running less than optimally.

This ‘MyTimer’ code is designed to run in a VBA class module (named MyTimer), and allows the developer to easily add timers throughout the code, complete with timer descriptions, as well as adding ‘laps’ (similar to a stopwatch) for when you need to time several different things within a single code run.

The full code is detailed below (simply copy it all into a blank class module called MyTimer, there’s a ‘Copy Code’ button for ease). There is also a download link at the bottom of the page to download as a class module to directly import into your VBA apps if you prefer.

(There is an example of how to use the code to run timers in your app, below the main code.)



VBA

Private tim As Double
Private Laps()

Sub PrintTime(Optional PrintTextWithTime As String)

Dim msg

If PrintTextWithTime = vbNullString Then
    msg = "Time from start: "
Else
    msg = PrintTextWithTime & ": "
End If

Debug.Print msg & FormatTime(Timer - tim)

End Sub

Sub StartLap(LapNumber As Long, Optional PrintTextWithTime As String)

If Not LapIsSet Then
    ReDim Laps(2, 0)
Else
    ReDim Preserve Laps(2, UBound(Laps) + 1)
End If

Laps(0, UBound(Laps, 2)) = LapNumber
Laps(1, UBound(Laps, 2)) = Timer
Laps(2, UBound(Laps, 2)) = PrintTextWithTime

End Sub

Sub PrintLap(LapNumber As Long)

Dim tmp As Double, prntText As String
Dim LapLookup As Long
Dim msg As String

LapLookup = LookupLapNumber(LapNumber)

If LapLookup = -1 Then
    msg = "Lap " & LapNumber & " not set"
Else
    tmp = Timer - Laps(1, LapLookup)
    msg = "Lap " & LapNumber
    prntText = Laps(2, LapLookup)
    If prntText <> vbNullString Then msg = msg & " (" & prntText & ")"
    msg = msg & ": " & FormatTime(tmp)
End If

Debug.Print msg


End Sub

Private Function LookupLapNumber(LapNumber As Long) As Long

Dim i As Long

If Not LapIsSet() Then
    LookupLapNumber = -1
    Exit Function
End If

For i = 0 To UBound(Laps, 2)
    If Laps(0, i) = LapNumber Then
        LookupLapNumber = i
        Exit Function
    End If
Next i

LookupLapNumber = -1

End Function

Private Sub Class_Initialize()
tim = Timer
End Sub

Private Sub Class_Terminate()
tim = 0
End Sub

Private Function LapIsSet() As Boolean

Dim tmp
On Error Resume Next
tmp = UBound(Laps, 2)
If Err.Number = 0 Then LapIsSet = True
On Error GoTo 0

End Function

Private Function FormatTime(YourTime As Double) As String

Dim h As Single, m As Single, s As Single

Select Case YourTime

    Case Is <= 60
        FormatTime = Format(YourTime, "0.00") & " sec(s)"
        
    Case Is <= 3600
        m = Int(YourTime / 60)
        s = Round(YourTime - (m * 60), 0)
        FormatTime = m & " min(s) " & s & "sec(s)"
        
    Case Else
        h = Int(YourTime / 3600)
        m = Int((YourTime - (h * 3600)) / 60)
        s = Round(YourTime - ((h * 3600) + (m * 60)), 0)
        FormatTime = h & " hour(s) " & m & " min(s) " & s & "sec(s)"
        
End Select

End Function



Example Code Usage

Sub Test_MyTimer()

Dim t As MyTimer
Set t = New MyTimer

'// Do First_Work

    t.PrintTime "First_Work"

    t.StartLap 1, "Second_Work"

'// Do Second_Work
    
    t.PrintLap 1
    t.PrintTime "End of sub"

End Sub

q

VBA Code Use Licence

You may use this code freely in all your projects. If doing so, please add the following text/link, either as a comment in your app’s code, or as a link if posting the code elsewhere:
Code provided freely by https://matrix9.co.uk

q

Code Disclaimer

This free code is provided as is, without warranty of any kind. Matrix9 accepts no responsibility for any untoward behaviour or effects of this code, however caused. It’s free to use, but use at your own risk!

Download VBA Class Module

Rather than copying the above code into a class module, if you prefer you can download the module here to import into your VBA app

Download Module