How to Time an Operation and Optimizing Code

I’ve found it beneficial to time how long it takes portions of my programs to run and in particular when a program takes longer to run than I initially expected.  Timing the different portions of a program tells you where the program is taking the most time and sometimes will help you find issues with your logic or how you’re using the API so you can make improvements to the execution time of your program.  Determining where your program spends time processing is referred to as profiling.  Some development environments provide profiling utilities and there are also 3rd party profilers available.  There’s no profiling functionality built-in to VBA so you’ll have to do something on your own.  Here’s the process I’ve used for several years to profile my VBA code.

First, I’ve created a small timer class.  I’ve found this easier to use and much more accurate than trying to use built-in VBA functions to get the current time.  Here’s the code for my timer class.

Private Declare Function QueryPerformanceFrequency _                  Lib "kernel32" (lpFrequency As Currency) As Long       Private Declare Function QueryPerformanceCounter _                   Lib "kernel32" (lpPerformanceCount As Currency) As Long             Private ConversionFactor As Currency       Private CurrentStartTime As Currency                   Public Sub Start()           Dim iReturn As Long           iReturn = QueryPerformanceCounter(CurrentStartTime)       End Sub                   Private Sub Class_Initialize()           Dim iReturn As Long           iReturn = QueryPerformanceFrequency(ConversionFactor)       End Sub                   Public Property Get CurrentTime() As Double           Dim NewTime As Currency           Dim iReturn As Long           iReturn = QueryPerformanceCounter(NewTime)           Dim TotalTime As Currency           TotalTime = NewTime - CurrentStartTime           CurrentTime = TotalTime / ConversionFactor       End Property

To add the code above to your VBA project, run the Class Module command from the Insert menu.  This will create a new, empty class module.  Copy and paste the code above into the new module.

Rename the class module to “clsTimer”  Do this by selecting the class module in the Project Explorer tree and then editing the name in the Properties window, as shown below.

Now you can use this class to time portions of your code.  Here’s a simple example.  This creates two instances of the timer class.  One that will be used to time small portions of the program and another that will be used to time the overall execution.  After creating a timer you call the Start method to begin timing.  At any time you can use the timer’s CurrentTime property to get the elapsed time.  You can also call the Start method again to restart the timer.  The value returned is the number of seconds that have elapsed since the timer started.  I use the VBA Format function to control the number of decimal places displayed.

Public Sub TimerExample()      ' Create and start a timer for the total time.             Dim timerAll As New clsTimer           timerAll.Start                   ' Create and start a timer for individual times.           Dim timer As New clsTimer         timer.Start            ' Time creating an assembly document.      Dim doc As Document         Set doc = ThisApplication.Documents.Add(kAssemblyDocumentObject)         Debug.Print "Assembly: " & Format(timer.CurrentTime, "0.000000")             ' Restart the timer.           timer.Start             ' Time creating a drawing document.           Set doc = ThisApplication.Documents.Add(kDrawingDocumentObject)         Debug.Print "Drawing: " & Format(timer.CurrentTime, "0.000000")             ' Restart the timer.           timer.Start            ' Time creating a part document.           Set doc = ThisApplication.Documents.Add(kPartDocumentObject)         Debug.Print "Part: " & Format(timer.CurrentTime, "0.000000")            ' Display the total time.      Debug.Print "Total: " & Format(timerAll.CurrentTime, "0.000000")     End Sub

Here’s another example that puts this into practice to try and optimize a program.  It gets all of the faces from the active part.

Public Sub GetFaces1()          ' Get the first body from the active part.      Dim partDoc As PartDocument           Set partDoc = ThisApplication.ActiveDocument           Dim body As SurfaceBody           Set body = partDoc.ComponentDefinition.SurfaceBodies.Item(1)                 ' Create a timer              Dim timer As New clsTimer                 ' Start the timer.              timer.Start                 ' Iterate through the faces using the Item property.              Dim oFace As Face           Dim i As Integer      For i = 1 To body.Faces.Count               Set oFace = body.Faces.Item(i)      Next                 Debug.Print "Time for " & body.Faces.Count & " faces: " & _                        Format(timer.CurrentTime, "0.000000")       End Sub

This results in the following being printed to my Immediate window:

Time for 1264 faces: 41.
421942

It takes forty-one seconds to iterate over the faces in the body.  Let’s look at some things that can be done to improve the performance. 

A common coding method, particularly in VB/VBA, is to string multiple calls together in a single line.  This is done in the code above in a few places.  The first is where it gets the SurfaceBody object.  It does this by calling the ComponentDefinition property of the PartDocument object, and then calls the SurfaceBodies property on the PartComponentDefinition object that’s returned, and finally calls the Item property on the returned SurfaceBodies object.  There are three API calls within that single line.  It’s ok in this case since it’s only executed once, but sometimes you can do excessive processing when these are within loops.

Another line where there are multiple calls being made is the one within the For loop where it’s getting the Face.  In this case, this line is being call 1264 times.  Here’s a modified version where the SurfaceBodies object is obtained once, outside the loop and then used within the loop to get each face.  The new and modifies lines are highlighted in red.

Public Sub GetFaces2()      ' Get the first body from the active part.      Dim partDoc As PartDocument           Set partDoc = ThisApplication.ActiveDocument           Dim body As SurfaceBody           Set body = partDoc.ComponentDefinition.SurfaceBodies.Item(1)                 ' Create a timer              Dim timer As New clsTimer                 ' Start the timer.              timer.Start                 ' Iterate through the faces using the Item property.              Dim oFace As Face           Dim i As Integer       Dim oFaces As Faces            Set oFaces = body.Faces           For i = 1 To body.Faces.Count          Set oFace = oFaces.Item(i)      Next                 Debug.Print "Time for " & body.Faces.Count & " faces: " & _                        Format(timer.CurrentTime, "0.000000")       End Sub

This results in the following being printed to my Immediate window:

Time for 1264 faces: 0.217899

We went from over 40 seconds down to less than one second.  This is over 190 times faster than the previous code, and a huge improvement.  Don’t always expect improvements like this, but taking the time to do a little profiling can often result in some time improvements.

There’s one more thing that can be done that might help with performance.  Instead of using the For statement to go from 1 to Count we can use the For Each statement.  This can result in better performance and also creates cleaner, easier to read code.

Public Sub GetFaces3()      ' Get the first body from the active part.      Dim partDoc As PartDocument           Set partDoc = ThisApplication.ActiveDocument           Dim body As SurfaceBody           Set body = partDoc.ComponentDefinition.SurfaceBodies.Item(1)                 ' Create a timer              Dim timer As New clsTimer                 ' Start the timer.              timer.Start                 ' Iterate through the faces using the Item property.              Dim oFace As Face      For Each oFace in body.Faces            Next                 Debug.Print "Time for " & body.Faces.Count & " faces: " & _                        Format(timer.CurrentTime, "0.000000")       End Sub

This results in the following being printed to my Immediate window:

Time for 1264 faces: 0.060036

This is an improvement of about 3.5 times over the earlier time.