Best Milliseconds Timer in VBA Tutorial

There are numerous sites that provide sample VBA codes for creating millisecond resolution timers.

Step 1: Search for the Right Windows API to solve a problem

There are numerous sites that provide sample VBA codes for creating millisecond resolution timers. In this tutorial, not only I will show the complete VBA codes that you can simply copy and use, I will describe the research process involved to create millisecond timers in VBA using Windows APIs so that you can deepen your understanding of using Windows APIs with VBA coding.

Our motivations to create a millisecond timers is to allow us to measure the execution time for a piece of VBA code. Ideally this timer should be able to measure up to millisecond resolutions. However, looking at native VBA and Excel time related functions they only provide up to seconds accuracy.

A web search on “timers using Windows API” eventually lead to this documentation. Great, so we can use 2 Windows APIs QueryPerformanceFrequency function to express the frequency, in counts per second and the QueryPerformanceCounter function to retrieve the current value of the high-resolution performance counter in order to measure time in milliseconds. The basic logic is to determine this logic: (“End Performance Counter” value – “Start Performance Counter” value / Performance Frequency value).

Step 2: How to Create the Windows API Function Declaration for VBA

In a previous article I described how this is done (you might want to go read that before continuing on here). A quick search for “QueryPerformanceFrequency” and “QueryPerformanceCounter” in the text file “Win32API_PtrSafe.TXT” which is the list of Windows API function declarations for VBA yielded this:

' Performance counter API's
Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" Alias _
    "QueryPerformanceCounter" (lpPerformanceCount As LARGE_INTEGER) As Long
Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" Alias _
    "QueryPerformanceFrequency" (lpFrequency As LARGE_INTEGER) As Long

What is this LARGE_INTEGER ?

Notice that the arguments to both Windows APIs have the data type LARGE_INTEGER. If we use this declaration as it is, VBA will give us a compile error: “User-defined type not defined”. A quick web search on the phrase “Windows API LARGE_INTEGER” tells us that it “Represents a 64-bit signed integer value”. So we can change the declarations slightly to use the native VBA 64-bit integer data type Currency.

' Performance counter API's
Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" _
    Alias "QueryPerformanceCounter" (lpPerformanceCount As Currency) As Long
Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" _
    Alias "QueryPerformanceFrequency" (lpFrequency As Currency) As Long

The Complete VBA Code for Millisecond Timer Using Windows APIs

So let’s put these 2 Windows API function declarations at the top of a code module and use it to measure elapsed time in milliseconds.

' Performance counter API's
#If VBA7 And Win64 Then
    'for 64-bit Excel
    Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
    Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
#Else
    'for 32-bit Excel
    Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
    Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
#End If


'Purpose: Measure elapsed time in milliseconds
Sub TimeACode()
    Dim curFrequency As Currency
    Dim curStartPerformanceCounter As Currency
    Dim curEndPerformanceCounter As Currency
    Dim lgResult As Long

    'obtain no: of counts per second
    lgResult = QueryPerformanceFrequency(curFrequency)
    If lgResult > 0 Then
        Debug.Print "Frequency: " & curFrequency
    End If

    'measure start count
    lgResult = QueryPerformanceCounter(curStartPerformanceCounter)
    If lgResult > 0 Then
        Debug.Print "Start Count: " & curStartPerformanceCounter
    End If
    

    '*****************************************
    'Insert the code to measure elapsed time
    '*****************************************
    
    
    'measure end count
    lgResult = QueryPerformanceCounter(curEndPerformanceCounter)
    If lgResult > 0 Then
        Debug.Print "End Count: " & curEndPerformanceCounter
    End If

    'measure elapsed time
    Debug.Print "Elapsed time (ms): " & (curEndPerformanceCounter - curStartPerformanceCounter) / curFrequency
End Sub

In my next tutorial, we will explore what kind of VBA codes can help to speed up execution times.

Leave a Reply

Your email address will not be published. Required fields are marked *

Contact Us

Drop us a message even when it’s late because the best ideas can come at night.

About Aeternus Singapore

aeternus consulting singapore logo
Aeternus Consulting is the premier consultancy firm for analyst-grade Microsoft Office training courses in Singapore. ACRA: T14LL0891K

Microsoft Office training solutions

corporate training course chair
We work with businesses and individuals who need effective Microsoft Office training solutions.

Analyst-Grade Training Courses

analytics with microsoft excel chart
Premium Training for Business Analysts, Data Analysts & Information Specialists in Singapore.

Our Services Include

Our Microsoft Office-centric services include:
* Full range of Microsoft Excel Training Courses in Singapore.
* Microsoft Office PowerPoint Training Courses.
* Consultancy in Excel, Access, VBA Application Development & PowerPoint Presentation Design Projects.
* Personal coaching & corporate bespoke Microsoft Office training sessions for employees.

Training Course List

Excel Basic, Intermediate, Advanced Levels
Excel PivotTables Inside Out
Data Management & Data Analysis in Excel
VBA Programming with Excel
Advanced VBA Programming with Excel
Essential Microsoft Excel for HR Professionals
Up to Speed with Microsoft PowerPoint
PowerPoint Design & Animation Ideas for Business
Microsoft SharePoint Training Workshop

Instagram (@aeternusconsulting)