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

Loading comments...