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
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.
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
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
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.
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.
Comments (2)
Commented:
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.
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: