Timing Multiple Chunks of Code - VBA

Published:
This is written from a 'VBA for MS Word' perspective, but I am sure it applies to most other MS Office components where VBA is used. 

One thing that really bugs me is slow code, ESPECIALLY when it's mine!  In programming there are so many ways to get a result it can be difficult for those of us who are relatively new to programming (and self taught) to figure out where the inefficiencies lie.  So I thought I would share this in the hope it helps someone. 

My problem was not timing code as such; there are some excellent articles covering that -- for example this by Martin Liss. What was not obvious to me was how to keep track of timing more than one block of code at a time. For example I have a procedure that calls other procedures; how do I find out which is taking the longest to run?
 
Sub myTest()
                      Dim i As Long
                      ' ====================
                      ' some code here
                      For i = 1 To 10000000
                      Next i
                      ' ====================
                      Call ExternalSub1
                      Call ExternalSub2
                      ' ====================
                      ' some code here
                      For i = 1 To 10000000
                      Next i
                      ' ====================
                      End Sub
                      
                      
                      Sub ExternalSub1()
                      Dim i As Long
                      ' ====================
                      ' some code here
                      For i = 1 To 5000000
                      Next i
                      ' ====================
                      End Sub
                      
                      Sub ExternalSub2()
                      Dim i As Long
                      ' ====================
                      ' some code here
                      For i = 1 To 20000000
                      Next i
                      ' ====================
                      End Sub

Open in new window

One solution that was more than adequate for my needs was to create a timer that logs the start and end times for each block of code that is run. The log file is a text file located in the same directory as the document that stores the macros. The timer uses a scripting dictionary to keep a track of the start times for each block of code under investigation. There is a potential bug (described towards the end of the article) - but for me  it's tolerable.

When the timer is called it accepts the name (or some other identifier) for the process to be timed... I just use the name of the sub / function that I wish to call. A boolean is used to indicate if we are starting or stopping the timer...
- True: Start the Timer
- False: Stop the Timer

EACH time the timer is started, a string is written to a scripting dictionary along with the corresponding TickCount. When the timer is stopped the TickCount recorded at the start is retrieved from the scripting dictionary for the corresponding item. The time taken for the code to run is EndTickCount - StartTickCount. Each tick is approx. 10 ms. The code is shown below:
 
Public Declare Function GetTickCount Lib "kernel32.dll" () As Long
                      Public odictTimer As Scripting.Dictionary
                      Public TickCount As Long
                      
                      Sub testTimer(CallBy As String, start As Boolean)
                      ' PURPOSE:
                      ' Use to record run time of blocks of code, required at start and
                      ' end of sub-routine.
                      '
                      ' Uses system tick count, time is measured in ticks :-)
                      
                      Dim str As String
                      
                      ' Exit if target file does not exist...
                      If Len(Dir(ThisDocument.Path & "\CodeRunTimes.txt")) = 0 Then GoTo lbl_Exit
                      
                      If odictTimer Is Nothing Then Set odictTimer = CreateObject("Scripting.Dictionary")
                      
                      If start Then ' start of subroutine to be called
                          If Not odictTimer.Exists(CallBy) Then
                              odictTimer.Add CallBy, GetTickCount
                          End If
                      Else
                          str = CallBy & ": " & GetTickCount - odictTimer.item(CallBy) & " ticks.  (" & Date & ")"
                          odictTimer.Remove (CallBy)
                          Open ThisDocument.Path & "\CodeRunTimes.txt" For Append As #1
                          Write #1, str
                          Close #1
                          Debug.Print str
                      End If
                      
                      lbl_Exit:
                          Exit Sub
                          
                      End Sub

Open in new window

In order to use the timer it needs to be started and stopped (obvious eh). The main point is that the call to the timer has an ID for the process being timed and the ID for the start and end of the process need to match. An example is shown below:
 
Sub myTest()
                      ' Start the timer for this SUB
                      ' - true for start timer
                      ' - false for stop timer
                      Call testTimer("myTest", True)
                      
                      Dim i As Long
                      
                      ' ====================
                      ' some code here
                      For i = 1 To 10000000
                      Next i
                      ' ====================
                      
                      ' Add timer around call to External Sub
                      Call testTimer("ExternalSub1", True)
                      Call ExternalSub1
                      Call testTimer("ExternalSub1", False)
                      
                      ' Add timer around call to External Sub
                      Call testTimer("ExternalSub2", True)
                      Call ExternalSub2
                      Call testTimer("ExternalSub2", False)
                      
                      ' ====================
                      ' some code here
                      For i = 1 To 10000000
                      Next i
                      ' ====================
                      
                      ' End the timer
                      Call testTimer("myTest", False)
                      
                      End Sub

Open in new window

A possible bug is that some code can be called / started more than once before the first instance ends. Assuming you are passing the procedure name to the timer then the timer will not be able to record instances > 1. In this case the timer will ignore the second call; the timer checks to see if a value exists in the dictionary and if it does, skips it.  A workaround may be to use a different ID for each call to the timer; however, for my purposes it works well.

I welcome suggestions for improvement and hope you find it helpful.
1
2,514 Views

Comments (2)

aikimarkGet vaccinated; Social distance; Wear a mask
CERTIFIED EXPERT
Top Expert 2014

Commented:
I you are only going down to the resolution of the GetTickCount() API, you could use the VB Timer function and multiply it by 100.

I have packaged the QueryPerformancecounter API into a class that allows me to start/stop each counter as required.  I have performance measure resolutions down to the single statement.

For i = 1 To 10000000
Next i

Open in new window

Be aware that the compiler does optimizations.  When you want to get a baseline for a loop, don't time an empty loop.  Make it do some lightweight operation, such as XOR applied to a byte or integer variable.

Author

Commented:
Thanks aikimark - nice tip :-)

Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.