Most Valuable Professional


View Jan Karel Pieterse's profile on LinkedIn subscribe to rss feed
Subscribe in a reader

Subscribe to our mailing list

* indicates required

Audit !!!

Check out our RefTreeAnalyser
the ultimate Excel formula auditing tool.

Trainings

Excel VBA Masterclass (English)
Excel VBA for Financials (Dutch)

Third party tools

Speed up your file

FastExcel
The best tool to optimise your Excel model!

Repair your file

Stellar Phoenix Excel Repair
Best tool to repair corrupt Excel sheets and objects
Home > English site > Articles > Performance Class
Deze pagina in het Nederlands

A VBA performance class

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:

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:

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 (4/29/2014 4:18:55 PM)

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 (7/30/2014 2:52:37 PM)

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 (8/12/2014 10:47:00 AM)

Hi Dave,

The demo misses a constant declaration in module modPerf:

Public Const gbDebug As Boolean = True

 


Comment by: Gilbert (12/6/2016 4:37:27 PM)

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"

 


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.

Please enter your name (required):

Your e-mail address (optional but if you want me to respond it helps!; will not be shown, nor be used to send you unsolicited information):

Your request or comment:

To post VBA code in your comment, use [VB] tags, like this: [VB]Code goes here[/VB].