Suggestions for testing and timing a UDF

[JenniferMurphy]

I can see at least 3 ways to code a UDF I am working on. I'd like to write another "tester/timer" UDF that will call each version a large number of times with a random combination of parameters to check for errors and to time them. Naturally, if errors are found, that version will be fixed or discarded. Of the ones that pass all tests, I would like to compare the time it took.

What is the best way to get the timings? If I understand the Timer function, it returns the time since midnight, so it only works if the code starts and stops in the same day (does not cross midnight).

What I would like to do is:

1. Start a timer.
2. Run the test cases against one of the versions.
3. Stop the timer.
4. Report the elapsed time.
5. Repeat with the next version.

Thanks

 

[BSALV]

timing
I suppose this is about your last question ...

Sub Measure_Time()
     Dim pM As Double, pN As Double

     pM = 50000
     pN = pM

     'in this part, you write the result to the sheet
     '**********************************
     If True Then
          Columns("A").ClearContents
          If pM < 32500 Then Range("A1").Value = RandSelect(pM, pN)     'only until +32.500
          Range("A2").Value = RandSelect_DanteAmor(pM, pN)      'write result in A2
          Range("A3").Value = RandSelect3(pM, pN)               'write result in A3
          RandSelect_Bart pM, pN
          Range("A10").Resize(UBound(Res)).Value = Res          'write result starting in A10 downwards
     End If

     'this part is timing
     '*************
     If pM < 32500 Then
          t = Timer
          For i = 1 To 10
               RandSelect pM, pN                                'macro from #1
          Next
          MsgBox "macro #1 = " & Timer - t
     End If

     t = Timer
     'For i = 1 To 10
     RandSelect_DanteAmor pM, pN
     'Next
     MsgBox "macro @DanteAmor = " & Timer - t

     t = Timer
     'For i = 1 To 10
     RandSelect3 pM, pN                                         'macro from #1
     'Next
     MsgBox "macro @Bebo = " & Timer - t

     t = Timer
     'For i = 1 To 10
     RandSelect_Bart pM, pN
     'Next
     MsgBox "macro Bart = " & Timer - t

End Sub

 

[Alex Blakenburg]

What is the best way to get the timings? If I understand the Timer function, it returns the time since midnight, so it only works if the code starts and stops in the same day (does not cross midnight).

You might want to have a look at this page on bettersolution.
VBA Macros - Timing
I have added PtrSafe on the assumption you are running 64 bit & VBA7.

Public Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long 

Public Sub Timer3() 
    starttime = timeGetTime() 
    Call RunCode 
    timeelapsed = (timeGetTime() - starttime) 
    Call MsgBox(timeelapsed & " seconds") 
End Sub

 

[GWteB]

For these kind of jobs I use a separate timer object. Its use is simple and clear and the results are very accurate.
The code is based on this article:

Acquiring high-resolution time stamps - Win32 apps

Windows provides APIs that you can use to acquire high-resolution time stamps or measure time intervals.

docs.microsoft.com

Usage example:

Public Sub JenniferMurphy()

    Dim TimeOne As Double, TimeTwo As Double

    Dim TimeWatch As CHiResTimer
    Set TimeWatch = New CHiResTimer
    With TimeWatch

        ' >> EXAMPLE 1 <<
        .StartTimer
            ' do stuff
        MsgBox .Elapsed

        ' >> EXAMPLE 2
        .ResetTimer
        ' do stuff
        TimeOne = .Elapsed
        ' do stuff
        TimeTwo = .Elapsed
        .StopTimer

        MsgBox "First time: " & TimeOne & vbNewLine & _
               "Second time: " & TimeTwo
    End With
End Sub

This goes in a Class module, te be renamed CHiResTimer:

Option Explicit
' ClassName:  CHiResTimer

#If VBA7 Then
    Private Declare PtrSafe Function QueryFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (lpFrequency As Currency) As Long
    Private Declare PtrSafe Function QueryCounter Lib "kernel32" Alias "QueryPerformanceCounter" (lpPerformanceCount As Currency) As Long
#Else
    Private Declare Function QueryFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (lpFrequency As Currency) As Long
    Private Declare Function QueryCounter Lib "kernel32" Alias "QueryPerformanceCounter" (lpPerformanceCount As Currency) As Long
#End If

Private Type TLocals
    Frequency   As Currency
    Overhead    As Currency
    Started     As Currency
    Stopped     As Currency
End Type
Private this As TLocals

Private Sub Class_Initialize()
    Dim Count1 As Currency, Count2 As Currency
    QueryFrequency this.Frequency
    QueryCounter Count1
    QueryCounter Count2
    this.Overhead = Count2 - Count1
End Sub

Public Sub StartTimer()
    QueryCounter this.Started
End Sub

Public Sub StopTimer()
    QueryCounter this.Stopped
End Sub

Public Sub ResetTimer()
    this.Started = 0
    this.Stopped = 0
    Me.StartTimer
End Sub

Public Sub Sleep(ByVal argSeconds As Double)
    Dim SleepTimer As CHiResTimer
    Set SleepTimer = New CHiResTimer
    With SleepTimer
        .StartTimer
        Do While .Elapsed < argSeconds
        Loop
        .StopTimer
    End With
    Set SleepTimer = Nothing
End Sub

Public Property Get Elapsed() As Double
    Dim Timer As Currency
    With this
        If .Stopped = 0 Then
            QueryCounter Timer
        Else
            Timer = .Stopped
        End If
        If .Frequency > 0 Then
            Elapsed = (Timer - .Started - .Overhead) / .Frequency
        End If
    End With
End Property

 

[Dan_W]

Personally, I like to use the timer feature in a VBA framework, stdVBA. The timer - called stdPerformance and downloadable from Github - is easy to use - it's just a matter of importing a class module and then setting it as follows:

        With stdPerformance.Measure("1. Add your timer label here:")
             [Code that you want to time]
        End With 
        With stdPerformance.Measure("2. Add your second timer label here:")
             [More code that you want to time]
        End With

And that's all. It then produces output that would look like:

1. Add your timer label here: 20 ms
2. Add your second timer label here: 120ms

Below is some sample code to try. It has a module level variable so it should go into a new module, and when you run the TimePerformance routine, it will create an array of folders in a given directory (that you need to set) using two methods - one using a dynamic array that is resized on each increment within the loop with Redim Preserve, and one where the size of the array is set before the loop. It's just simple example. The output of the code below is:

Method 1. Resizing dynamic array in a loop: 94 ms
Method 2. Set dynamic array size once: 68 ms

Results
Method 1 - 205 folders founds
Method 2 - 205 folders founds

Private InLoop As Boolean
Sub TimePerformance()
    Dim Results As Variant
    
    With stdPerformance.Optimise
       
        With stdPerformance.Measure("Method 1. Resizing dynamic array in a loop")
            
            InLoop = True
            Results1 = ListFolders("D:\Github\")
        
        End With
        With stdPerformance.Measure("Method 2. Set dynamic array size once")
            
            InLoop = False
            Results2 = ListFolders("D:\Github\")
        
        End With
        
        Debug.Print vbNewLine & "RESULTS"
        Debug.Print "Method 1 - " & UBound(Results1) & " folders founds"
        Debug.Print "Method 2 - " & UBound(Results2) & " folders founds"
        
    End With
End Sub


Function ListFolders(FolderPath As String) As Variant
    
    Dim FSO             As Object
    Dim FSOFolder       As Object
    Dim SubFolder       As Object
    Dim I               As Long
    Dim SubfolderName() As String
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set FSOFolder = FSO.GetFolder(FolderPath)
    
    If InLoop Then
        For Each SubFolder In FSOFolder.SubFolders
            ReDim Preserve SubfolderName(I)
            SubfolderName(I) = SubFolder.Name
            I = I + 1
        Next SubFolder
    Else
        ReDim SubfolderName(FSOFolder.SubFolders.count - 1)
        For Each SubFolder In FSOFolder.SubFolders
            SubfolderName(I) = SubFolder.Name
            I = I + 1
        Next SubFolder
    End If
    
    ListFolders = SubfolderName
    
    Set SubFolder = Nothing
    Set FSOFolder = Nothing
    Set FSO = Nothing
    
End Function

 

[BSALV]

in the link of #2 now with the 3rd method of @Alex Blakenburg added, but i don't think you need a photofinish.
Run the macro with pm=10, 100, 10000, 32500, 100000 and 1000000

 

[BSALV]

The chronometer of @Dan_W, apparently i think i copied something wrong from that site and it doesn't work ...
Can you have a look at the beginning of that ClassModule ?

jennifer

 

[GWteB]

@BSALV, the timings in your post #2 code are measured with the VBA.Timer function, but if I understood correctly the OP is looking for an alternative, considering ...

If I understand the Timer function, it returns the time since midnight, so it only works if the code starts and stops in the same day (does not cross midnight).

That assumption is correct, the Timer function returns a Single var type representing the number of seconds elapsed since midnight, so any code needs to take that into account.

Both @Alex Blakenburg's submission and mine are less or not affected by a 24-hour change on short notice.
The timeGetTime function returns the system time in milliseconds, i.e. the time elapsed since Windows was started. If the system is run continuously its return value wraps around to 0 approx every 49 days.
The QueryPerformanceCounter function on the other hand is completely independent of the system time and UTC.

but i don't think you need a photofinish.

Perhaps not, but an interval smaller than 1 millisecond might come in handy with short running procedures, and that's what my code provides in addition to time independency.
Other than that, imho my code is less "complicated" than the suggested version on GitHub. The latter is using the GetTickCount function which is effectively similar to the timeGetTime function. However, the GitHub version is also usable on the Mac, mine isn't.

The chronometer of @Dan_W, apparently i think i copied something wrong from that site and it doesn't work ...

I did not test this GitHub version (as I said, I don't need to ...) but according to how it's written the default instance of the class is used to create the actual object. This means the code needs to be pasted in a Class module with the PredeclaredID attribute set to TRUE. You need to copy the entire code and paste it in a text editor and save it on disk with file name stdPerformance.cls. Within the VBE that file needs to be imported (Ctrl M). After that all public methods and functions of the default instance of that class (like the .Create function) are accessible.

 

[Dan_W]

The chronometer of @Dan_W, apparently i think i copied something wrong from that site and it doesn't work ...
Can you have a look at the beginning of that ClassModule ?

jennifer

So it can't be copied and pasted. You need to download it and then import it - that's important!

 

[BSALV]

crystal clear.
jennifer