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.
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
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:
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
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.
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
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.