Get code runtimes via GetTickCount and format it in specific ways

Question

I'm trying to make VBA's GetTickCount work so that I can see the runtime of code, but it doesn't have to be super accurate.

The following bit of code works good but I need a few changes and can't work out how to achieve this.

#If Win64 Then
    Public Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
#Else
    Public Declare Function GetTickCount Lib "kernel32" () As Long
#End If

' Get first tickcount, start of code
t1 = GetTickCount

'Do stuff here
'#############
'#############
'#############

' Get second tickcount, end of code
t2 = GetTickCount

' Compare tickcounts
If t2 < t1 Then
    ' If t2 is smaller than t1 then the tickcount has been reset, use reset tick value + t2 - t1
    Application.StatusBar = "VBA Code Runtime ms: " & (4294967295# + t2) - t1
Else
    ' If t2 is bigger than t1 then just use t2 - t1
    Application.StatusBar = "VBA Code Runtime ms: " & t2 - t1
End If

I want the runtime to be presented in the following ways.

• If runtime under 1 second it should be presented in milliseconds. Example: 180 milliseconds
• If runtime under 1 minute but more than 1 second it should be presented in seconds (no milliseconds). Example: 30 seconds
• If runtime OVER 1 minute but less than 1 hour it should be presented in minute second. Example: 1 minute, 30 seconds
• If runtime OVER 1 hour it should be presented in hours, minutes and second Example: 2 hours, 1 minute, 30 seconds

How would I achieve this, any help would be much appreciated.

Answer 1

This should get you the rudimentary results you are looking for.

Sub myStopwatch()
    Dim t1 As Double, t2 As Double, et As Double, mssg As String

    Application.StatusBar = "Running..."
    Debug.Print "Start at: " & Time
    t1 = Timer

        ' do stuff here

    t2 = Timer
    Debug.Print "End at: " & Time

    et = t2 - t1 + Abs((t2 < t1) * 86400)
    mssg = "VBA Code Runtime: "
    Select Case et
        Case Is < 1
            mssg = mssg & Format(et, "0.000 \m\s")
        Case 1 To 59.999
            mssg = mssg & Format(Int(et), "0 \s") 'this one rounds down
            'mssg = mssg & Format(et\1, "0 \s") this one rounds it off up or down
        Case 60 To 3599.999
            mssg = mssg & Format(Int(et / 60), "0 \m\, ") & Format(et Mod 60, "0 \s")
        Case Is >= 3600
            mssg = mssg & Format(Int(et / 3600), "0 \h\, ") & Format(Int((et Mod 3600) / 60), "0 \m\, ") & Format(et Mod 60, "0 \s")
        Case Else
            'do nothing
    End Select

    Application.StatusBar = mssg

End Sub

I've used the VBA's built-in Timer rather than GetTickCount as you only need a maximum of 10 hours. Timer resets at midnight so it isn't useful for extended timing sessions. I've compensated for one midnight turnover.

If you are leary of the results, go to the VBE's Immediate Window (e.g. Ctrl+G) to see the actual start and stop times.

More on criteria with the select case method at Select...Case Statement (Visual Basic).