A VBA performance class

Content

Introduction
Working principle
Where is the performance data stored
The clsPerf class
The modPerf module
The modTimer module
Implementing the clsPerf class in your routines
Reporting the results
Demo file
Conclusion

Introduction

If you write a lot of VBA code you probably sometimes run into performance issues. A customer rings you and complains that the Excel file you built for them does not perform well. In this little article I provide a bit of VBA code that will help you trouble-shoot these performance issues.

Working principle

The code I'm about to show makes use of a very basic VBA principle: variables declared at the routine level go out of scope as soon as the routine ends. If such a variable points to an instance of a class, the class' terminate event is fired. The system proposed here consists of these elements:

A class module called clsPerf in which we keep score of the time the class was initialised and which extends and fills an array with values: the name of the calling routine, the start time and the elapsed time
A normal module modPerf with routines to reset the performance array, to report the performance count and a couple of public variables to keep track of what's been logged by the classes.
A normal module modTimer which holds some API declarations and a function to get a high resolution timestamp (courtesy Charles Williams)
A bit of code in each of your routines you wish to troubleshoot.

Where is the performance data stored

I've kept that very simple. Since I plan to dump the performance data into a worksheet and dumping a variant array to a worksheet is very fast, I simply declared a public variant array in the modPerf module, along with a couple of other variables:

'For clsPerf Class:
Public Const gbDebug As Boolean = True
Public glPerfIndex As Long
Public gvPerfResults() As Variant
Public glDepth As Long

I use glPerfIndex to record how many elements are in the variant array and I use glDepth so I can indent the routine names according to where in the call stack they are. gbDebug is a constant you can set to False to stop using the performance class.

The clsPerf class

The clsPerf class is rather straightforward:

Option Explicit

'Which item of gvPerfResults "belongs" to this instance?
Dim mlIndex As Long

'When did we start
Dim mdStartTime As Double

Private Sub Class_Initialize()
    'New item to keep track of, increase #
    glPerfIndex = glPerfIndex + 1
    'store which one is in this class instance
    mlIndex = glPerfIndex
    'Increase the depth to create an illusion of a call stack
    glDepth = glDepth + 1
    If IsBounded(gvPerfResults) Then
        ReDim Preserve gvPerfResults(1 To 3, 1 To glPerfIndex)
    Else
        ReDim gvPerfResults(1 To 3, 1 To glPerfIndex)
    End If
    'Record when this instance was started
    mdStartTime = dMicroTimer
End Sub

Public Sub SetRoutine(sRoutineName)
    gvPerfResults(1, mlIndex) = String(glDepth * 4, " ") & sRoutineName
End Sub

Private Sub Class_Terminate()
    'Called automatically when the variable pointing to this
    'class' instance goes out of scope

    'Outdent the call stack depth
    glDepth = glDepth - 1
    'Record starttime and run-time
    gvPerfResults(2, mlIndex) = mdStartTime
    gvPerfResults(3, mlIndex) = dMicroTimer - mdStartTime
End Sub

Private Function IsBounded(vArray As Variant) As Boolean
    Dim lTest As Long
    On Error Resume Next
    lTest = UBound(vArray)
    IsBounded = (Err.Number = 0)
End Function

The modPerf module

Some code in a normal module is needed to hold the array and for ease of use I have also added a reporting routine:

Option Explicit

'For clsPerf Class:
Public Const gbDebug As Boolean = True
Public glPerfIndex  As Long
Public gvPerfResults() As Variant
Public glDepth As Long

Sub Demo()
    Dim cPerf As clsPerf
    ResetPerformance
    If gbDebug Then
        Set cPerf = New clsPerf
        cPerf.SetRoutine "Demo"
    End If
    Application.OnTime Now, "ReportPerformance"
End Sub

Public Sub ResetPerformance()
    glPerfIndex = 0
    ReDim gvPerfResults(1 To 3, 1 To 1)
End Sub

Public Sub ReportPerformance()
    Dim vNewPerf() As Variant
    Dim lRow As Long
    Dim lCol As Long
    ReDim vNewPerf(1 To UBound(gvPerfResults, 2) + 1, 1 To 3)
    vNewPerf(1, 1) = "Routine"
    vNewPerf(1, 2) = "Started at"
    vNewPerf(1, 3) = "Time taken"

    For lRow = 1 To UBound(gvPerfResults, 2)
        For lCol = 1 To 3
            vNewPerf(lRow + 1, lCol) = gvPerfResults(lCol, lRow)
        Next
    Next
    Workbooks.Add
    With ActiveSheet
        .Range("A1").Resize(UBound(vNewPerf, 1), 3).Value = vNewPerf
        .UsedRange.EntireColumn.AutoFit
    End With
    AddPivot
End Sub

Sub AddPivot()
    Dim oSh As Worksheet
    Set oSh = ActiveSheet
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
                                      oSh.UsedRange.Address(external:=True), Version:=xlPivotTableVersion14).CreatePivotTable _
                                      TableDestination:="", TableName:="PerfReport", DefaultVersion:= _
                                      xlPivotTableVersion14
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    With ActiveSheet.PivotTables(1)
        With .PivotFields("Routine")
            .Orientation = xlRowField
            .Position = 1
        End With
        .AddDataField ActiveSheet.PivotTables(1).PivotFields("Time taken"), "Total Time taken", xlAverage
        .PivotFields("Routine").AutoSort xlDescending, "Total Time taken"
        .AddDataField .PivotFields("Time taken"), "Times called", xlCount
        .RowAxisLayout xlTabularRow
        .ColumnGrand = False
        .RowGrand = False
    End With
End Sub

Basically all you need to do with this module is run the "ReportPerformance" routine when you've run your code.

The modTimer module

This module contains some API declarations and a single routine to get a timestamp:

Option Explicit
Option Private Module
#If VBA7 Then
    Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
    Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long
#Else
    Private Declare Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    Private Declare Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
    Private Declare Function timeGetTime Lib "winmm.dll" () As Long
#End If

Private mdTime As Double
Private msComment As String

Public Function dMicroTimer() As Double
'-------------------------------------------------------------------------
' Procedure : dMicroTimer
' Author    : Charles Williams www.decisionmodels.com
' Created   : 15-June 2007
' Purpose   : High resolution timer
'             Used for speed optimisation
'-------------------------------------------------------------------------

    Dim cyTicks1 As Currency
    Dim cyTicks2 As Currency
    Static cyFrequency As Currency
    dMicroTimer = 0
    If cyFrequency = 0 Then getFrequency cyFrequency
    getTickCount cyTicks1
    getTickCount cyTicks2
    If cyTicks2 < cyTicks1 Then cyTicks2 = cyTicks1
    If cyFrequency Then dMicroTimer = cyTicks2 / cyFrequency
End Function

Implementing the clsPerf class in your routines

Entry routines

In all your entry routines (routines you see as starting point of a core functionality of your project), you might want to reset the variables of the performance timer. This is done my calling the "ResetPerformance" subroutine shown above.

All other routines

In all other routines you add these items:

A variable declaration which is going to hold an instance of the clsPerf class
An If Then structure which tests for the gbDebug constant and if True loads an instance of the clsPerf class and stores the routine name in the class. The cPerf variable will automatically go out of scope once the routine ends, which will fire the Terminate event of the class so the end time can be recorded.

Sub Demo()
    Dim cPerf As clsPerf
    If gbDebug Then
        Set cPerf = New clsPerf
        cPerf.SetRoutine "Demo"
    End If
    'Your code goes here
End Sub

That is all!

Make sure that you instantiate the performance class AFTER you have gathered any user information through programming constructions like GetOpenFileName or MsgBox or Userforms, otherwise you are just timing how long the user takes to answer the questions your code is asking, rather than testing the performance of your code.

Reporting the results

When your routine has ended, simply run the sub called "ReportPerformance" in the modPerf module to get the full table of timings and a summary pivot table.

Demo file

Download the demo

Conclusion

Hopefully I've helped you out a bit here by making troubleshooting for performance a tiny bit easier. Let me know your findings!

Comments

All comments about this page:

Comment by: Jon (29-4-2014 16:18:55) deeplink to this comment

I write a lot of VBA for Visio, and all our code is wired for performance tracking, by calling a routine on start and end of a function. These routines maintain a call stack, so we can dump that out when we get an error, but we can also switch on performance profiling, that will track the start and end time (tick count) of every function call, along with the call stack level.
We can them dump this to a txt file (too big for Excel,usually), and plot a Flame Chart, which is a tremendously useful way to visualize performance. It really helps you zoom in on where your performance issues are.

Comment by: Dave (30-7-2014 14:52:37) deeplink to this comment

hi, i came across your post about the performance class. I think i get what it does. I was hoping to learn more because i think i can use this......the problem is that when i try to run it i get a run time error...........

can you post an example on how to use this.....ie...a file or something. i downloaded your example but again there is a compile issue with a variable not being defined and then a runtime issue.

Comment by: Jan Karel Pieterse (12-8-2014 10:47:00) deeplink to this comment

Hi Dave,

The demo misses a constant declaration in module modPerf:

Public Const gbDebug As Boolean = True

Comment by: Gilbert (6-12-2016 16:37:27) deeplink to this comment

Code works fine.
If you get an error about the xlPivotTableVersion14
just remove the 14 at the end, type Control+Space to see available values, and select highest available one.

On my Office 2007 It was "12"

Comment by: Spid (13-8-2019 14:44:00) deeplink to this comment

This is the most usefull and simple code i ever see for timers, really like the Class_Terminate that is called automatically.
Great job !!!

Have a question, comment or suggestion? Then please use this form.

If your question is not directly related to this web page, but rather a more general "How do I do this" Excel question, then I advise you to ask your question here: www.eileenslounge.com.