Accurate Performance Timers in VBA

March 8, 2013 in VBA

There are many times when you want to know how fast your code really is. Especially if you find your VBA application responding slowly you need to know where the bottleneck is occurring. You can build a Stopwatch type class around the built-in VBA Timer function, but this will only get you resolution up to a few milliseconds and also suffers from some quirks in the Timer function. I won’t cover those in this article, but I will show how to make a super accurate Stopwatch class using the Windows API functions QueryPerformanceFrequency and QueryPerformanceCounter. For an in-depth look at these functions, see the MSDN Magazine article Implement a Continuously Updating, High-Resolution Time Provider for Windows.

High-resolution performance counters

The performance counter API functions provide access to the high-resolution performance counter on your computer. Performance counters are implemented directly in hardware on the CPU (see Hardware Performance Counter). Performance counters don’t actually measure time, instead they just increment a counter at a very small and very precise interval. Performance counters are not perfectly accurate for measuring calendar time over the long term but they are extremely precise and regular. You can count on it always taking exactly the same amount of time to “tick”, say, 10000 times, to a precision on the order of nanoseconds.

That said you usually want to convert ticks to time. In order to do this you need three pieces of information: the start counter value, the end counter value, and the counter frequency. QueryPerformanceCounter provides the the counter value, while QueryPerformanceFrequency tells us how many times the counter increments its count per second. This allows us to convert the number of ticks elapsed to seconds elapsed. On my system the counter frequency is 2,922,431. Yes, that’s more than 2 million ticks per second, or a tick length of 342 nanoseconds. Compare this to the tick rate of the VBA Timer function, which on my computer is 256 ticks per second, or a tick length of 3.91 milliseconds. Put another way, my hardware performance counter ticks about 11,416 times for every tick of the system clock represented by the Timer function.

Declaring the API functions

Both QueryPerformanceFrequency and QueryPerformanceCounter use unsigned 64-bit integers. This data type is not available in VBA natively, so we first have to define our own type to hold the data passed from the API functions, along with a helper function to convert the raw unsigned 64-bite integers to VBA Doubles:

Uint64 Type
Private Type UINT64
    LowPart As Long
    HighPart As Long
End Type

Private Const BSHIFT_32 = 4294967296# ' 2 ^ 32

Private Function U64Dbl(U64 As UINT64) As Double
    Dim lDbl As Double, hDbl As Double
    lDbl = U64.LowPart
    hDbl = U64.HighPart
    If lDbl < 0 Then lDbl = lDbl + BSHIFT_32
    If hDbl < 0 Then hDbl = hDbl + BSHIFT_32
    U64Dbl = lDbl + BSHIFT_32 * hDbl
End Function&#91;/vb&#93;

The Declare statements for the functions themselves are simple. Note the argument for each function is implicitly ByRef, and uses the user defined type just created:

&#91;vb&#93;Private Declare Function QueryPerformanceCounter Lib "kernel32" ( _
    lpPerformanceCount As UINT64) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" ( _
    lpFrequency As UINT64) As Long&#91;/vb&#93;

<h4 title="Measuring time with QueryPerfomance">Measuring time elapsed</h4>

Here's how you would use these API functions directly to measure the time it takes to do something:

[vb]Dim u64Start As UINT64
Dim u64End As UINT64
Dim u64Fqy As UINT64
Dim dblElapsed As Double

' Get the counter frequency
QueryPerformanceFrequency u64Fqy

' Get the counter before
QueryPerformanceCounter u64Start

' Do something
Call MySub

' Get the counter after
QueryPerformanceCounter u64End

'Calculate the elapsed seconds
dblElapsed = (U64Dbl(u64End) - U64Dbl(u64Start)) / U64Dbl(u64Fqy)

Debug.Print Format(dblElapsed, "0.000000"); " seconds elapsed ("; _
            Format(U64Dbl(u64End) - U64Dbl(u64Start), "#,##0"); " ticks)"

Creating a Stopwatch class

We can make these methods a lot more useful by wrapping them in a Stopwatch class. This will hide the API complexity from the rest of the code while adding some handy intuitive methods. Here’s the complete code for my Stopwatch class. Paste it in a new class module call Stopwatch and you’re good to go:

Option Explicit

Private Declare Function QueryPerformanceCounter Lib "kernel32" ( _
    lpPerformanceCount As UINT64) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" ( _
    lpFrequency As UINT64) As Long

Private pFrequency As Double
Private pStartTS As UINT64
Private pEndTS As UINT64
Private pElapsed As Double
Private pRunning As Boolean
   
Private Type UINT64
    LowPart As Long
    HighPart As Long
End Type

Private Const BSHIFT_32 = 4294967296# ' 2 ^ 32

Private Function U64Dbl(U64 As UINT64) As Double
    Dim lDbl As Double, hDbl As Double
    lDbl = U64.LowPart
    hDbl = U64.HighPart
    If lDbl < 0 Then lDbl = lDbl + BSHIFT_32
    If hDbl < 0 Then hDbl = hDbl + BSHIFT_32
    U64Dbl = lDbl + BSHIFT_32 * hDbl
End Function

Private Sub Class_Initialize()
    Dim PerfFrequency As UINT64
    QueryPerformanceFrequency PerfFrequency
    pFrequency = U64Dbl(PerfFrequency)
End Sub

Public Property Get Elapsed() As Double
    If pRunning Then
        Dim pNow As UINT64
        QueryPerformanceCounter pNow
        Elapsed = pElapsed + (U64Dbl(pNow) - U64Dbl(pStartTS)) / pFrequency
    Else
        Elapsed = pElapsed
    End If
End Property

Public Sub Start()
    If Not pRunning Then
        QueryPerformanceCounter pStartTS
        pRunning = True
    End If
End Sub

Public Sub Pause()
    If pRunning Then
        QueryPerformanceCounter pEndTS
        pRunning = False
        pElapsed = pElapsed + (U64Dbl(pEndTS) - U64Dbl(pStartTS)) / pFrequency
    End If
End Sub

Public Sub Reset()
    pElapsed = 0
    pRunning = False
End Sub

Public Sub Restart()
    pElapsed = 0
    QueryPerformanceCounter pStartTS
    pRunning = True
End Sub

Public Property Get Running() As Boolean
   Running = pRunning
End Property&#91;/vb&#93;

<h5>Using the Stopwatch class</h5>
Now it's easy to accurately measure time. Here's the updated version of the example above, using the <span class="member-name">Stopwatch</span> class instead of the direct API functions:

[vb]With New Stopwatch
    .Restart
    Call MySub ' Do something
    .Pause
    Debug.Print Format(.Elapsed, "0.000000"); " seconds elapsed"
End With

Conclusion

Using a couple of Windows API functions you can use your hardware performance counter to accurately measure extremely short time intervals. This is helpful when profiling and tuning your code. Going an extra step and wrapping these function in a class module makes them even easier to use throughout your project.