A rather accurate VBA stopwatch Announcing the arrival of Valued Associate #679: Cesar Manara Planned maintenance scheduled April 17/18, 2019 at 00:00UTC (8:00pm US/Eastern)VBA Code ProfilingPublic Function to remove empty or “” elements from a single dimension arrayList<T> implementation for VB6/VBAEnforcing Type with Boiler PlatesParameterised ConstructorsVBA Code ProfilingVBA Text Array - Scan two columns rather than oneMeasuring performance of code using StopWatchVBA code for testing efficencyFunctional FrameworkAccessing properties by name with compile-time typesafetyMS Office Suite VBA: ShellWait() and PowerShell()

Proof involving the spectral radius and Jordan Canonical form

Is high blood pressure ever a symptom attributable solely to dehydration?

Why don't the Weasley twins use magic outside of school if the Trace can only find the location of spells cast?

Why did the IBM 650 use bi-quinary?

What makes black pepper strong or mild?

How do I keep my slimes from escaping their pens?

The logistics of corpse disposal

Models of set theory where not every set can be linearly ordered

How much radiation do nuclear physics experiments expose researchers to nowadays?

Is there a "higher Segal conjecture"?

How to find all the available tools in macOS terminal?

Why aren't air breathing engines used as small first stages

What is the musical term for a note that continously plays through a melody?

Withdrew £2800, but only £2000 shows as withdrawn on online banking; what are my obligations?

Why is black pepper both grey and black?

How to deal with a team lead who never gives me credit?

Is it true that "carbohydrates are of no use for the basal metabolic need"?

If 'B is more likely given A', then 'A is more likely given B'

What is a Meta algorithm?

ListPlot join points by nearest neighbor rather than order

I am not a queen, who am I?

Can inflation occur in a positive-sum game currency system such as the Stack Exchange reputation system?

Is there a concise way to say "all of the X, one of each"?

How can players work together to take actions that are otherwise impossible?



A rather accurate VBA stopwatch



Announcing the arrival of Valued Associate #679: Cesar Manara
Planned maintenance scheduled April 17/18, 2019 at 00:00UTC (8:00pm US/Eastern)VBA Code ProfilingPublic Function to remove empty or “” elements from a single dimension arrayList<T> implementation for VB6/VBAEnforcing Type with Boiler PlatesParameterised ConstructorsVBA Code ProfilingVBA Text Array - Scan two columns rather than oneMeasuring performance of code using StopWatchVBA code for testing efficencyFunctional FrameworkAccessing properties by name with compile-time typesafetyMS Office Suite VBA: ShellWait() and PowerShell()



.everyoneloves__top-leaderboard:empty,.everyoneloves__mid-leaderboard:empty,.everyoneloves__bot-mid-leaderboard:empty margin-bottom:0;








3












$begingroup$


Intro



Related, related



I'm trying to come up with a neat, accurate way of timing VBA code, as I'm yet to find a method to do this in VBA directly (without plugins etc.)



The general idea was to create some Stopwatch class which could be initialised at the start of a test procedure, then various markers could be dotted throughout the code under review and when execution reaches these markers, the stopwatch class makes a note of the time.



To get an in-depth profile of code execution, I wanted to be able to differentiate between Main methods and Sub methods (ie if Sub Foo calls Sub A and Sub B, it would be nice to have stats for Foo, and beneath it, A and B individually). Another LabelTree class could be used to build up this hierarchy model.



Finally a StopwatchResults class can hold methods required to turn raw timestamp data (held in TimeInfo classes) into execution times for different methods, and return that info in required formats (currently just printing or as a LabelTree object).



Put that all together and you can write something like this:





Sub testRoutine()
Dim ck As New Stopwatch
ck.Start
ck.OpenLabel "HeavyWork"
DoSomeHeavyWork
ck.CloseLabel
ck.OpenLabel "LoopTest"
Dim i As Long
For i = 1 To 5
DoSomeHeavyWork 0.1
ck.Lap
Next i
ck.CloseLabel
ck.Finish
ck.Results.ToImmediateWindow
End Sub


Which prints for example:



Label name Time taken
-----------------------------------
1 Start 1.00116134128621 1.90410726645496E-03
1.1 HeavyWork 0.500211852449866 2.6879100187216E-04
1.2 LoopTest 0.500682749669068 1.43936557287816E-03
1.2.1 Lap1 0.100088742066873 2.34935650951229E-04
1.2.2 Lap2 0.100127727018844 2.38013410125859E-04
1.2.3 Lap3 0.100125675184245 2.53402205999009E-04
1.2.4 Lap4 0.100125675184245 2.53402205999009E-04
1.2.5 Lap5 0.10012362334237 2.50324446824379E-04


NB. DoSomeHeavyWork here was just a pause of length seconds



Sub DoSomeHeavyWork(Optional length As Single = 0.5)
Dim startTime As Single
startTime = Timer
Do Until Timer - startTime > length
'DoEvents
Loop
End Sub


Labels



You can see how the test code makes use of labels to enclose portions of the code. Think of labels like brackets, you can OpenLabel and CloseLabel and partition the code into sections like that, the stopwatch measures time between the brackets.



.Start and .Finish are just labels with default name, equivalent to .OpenLabel("Start") and .CloseLabel respectively.



.Lap is a special kind of label. Rather than needing to open and close, laps are used to characterise loops. They measure time relative to the previous label (be it an openLabel/Start or another Laplabel)



Nested labels are considered child nodes in the tree of hierarchy, so "HeavyWork" is a child of the "Start" label. Lap labels are special and can't have child nodes; i.e. you can't make a sub label within a lap measurement (behaviour which I may change, but can be worked around by using a normal label instead)



With this bracket model the code becomes (Laps open and close their own brackets, except Lap1)



Start(
HeavyWork(
)
LoopTest(
Lap1)
(Lap2)
(Lap3)
(Lap4)
(Lap5)
)
)


How the timing works



The idea was to ensure that the time recorded for a given run was independent of the presence of the stopwatch class. For that reason whenever the class is accessed, it mesures a time-in and a time-out (i.e., it times anything it does between receiving control and handing it back to the caller). This time is subtracted from overall execution time to reduce the impact of of the class on timing results.



The time registered on a label is therefore:



(Time into close label) - (Time out of open label) - (Time wasted by stopwatch class in all child nodes)


Implementation



To add all of these modules to a project at once, add and run the extract method of this compressed file. You'll need to allow programmatic access to the project




Stopwatch class



Class to generate label tree hierarchy (Start,OpenLabel,CloseLabel,Lap,Finish), and calculate timestamps (MicroTimer) at each label. These are stored in a dictionary using keys based on the location of a label within the tree



Option Explicit

Private Type TStopWatch
data As Object
CurrentLabel As LabelTree
Results As StopwatchResults
FirstLabel As LabelTree
End Type

Private this As TStopWatch

Private Declare PtrSafe Function getFrequency Lib "kernel32" _
Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare PtrSafe Function getTickCount Lib "kernel32" _
Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long

Private Function MicroTimer() As Double
'Accurate timing method - stackoverflow.com/a/7116928/6609896
Dim cyTicks1 As Currency
Static cyFrequency As Currency

MicroTimer = 0

If cyFrequency = 0 Then getFrequency cyFrequency

getTickCount cyTicks1

If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
End Function

Public Sub Start()
OpenLabel "Start"
End Sub

Public Sub Finish()
CloseLabel
Set this.Results = New StopwatchResults
this.Results.LoadData this.data, this.FirstLabel
End Sub

Public Property Get Results() As StopwatchResults
Set Results = this.Results
End Property

Public Sub OpenLabel(ByVal labelName As String)
'Save time on arrival
Dim clockTimes As New TimeInfo
clockTimes.TimeIn = MicroTimer

'Define new label, and make it a child of the current label
Dim newNode As New LabelTree
newNode.NodeName = labelName
If Not this.CurrentLabel Is Nothing Then
Set newNode.parentNode = this.CurrentLabel
'1.2.1 format
newNode.Location = this.CurrentLabel.Location & "." & this.CurrentLabel.ChildNodes.Count + 1
this.CurrentLabel.ChildNodes.Add newNode, newNode.Location & newNode.NodeName
Else
newNode.Location = "1"
Set this.FirstLabel = newNode
End If
Set this.CurrentLabel = newNode

'Save time data to dictionary and return to execution
Dim dictKey As String
dictKey = newNode.Location & "_open"
this.data.Add dictKey, clockTimes
this.data(dictKey).TimeOut = MicroTimer
End Sub

Public Sub CloseLabel()
'Save time on arrival
Dim clockTimes As New TimeInfo
clockTimes.TimeIn = MicroTimer

'Save time data to dictionary and return to execution
Dim dictKey As String
dictKey = this.CurrentLabel.Location & "_close"
this.data.Add dictKey, clockTimes

'Close label by setting to parent
Set this.CurrentLabel = this.CurrentLabel.parentNode
this.data(dictKey).TimeOut = MicroTimer
End Sub

Public Sub Lap()
'Save time on arrival
Dim clockTimes As New TimeInfo
clockTimes.TimeIn = MicroTimer

'Define new label, and make it a child of the current label
Dim newNode As New LabelTree
newNode.Location = this.CurrentLabel.Location & "." & this.CurrentLabel.ChildNodes.Count + 1
newNode.NodeName = "Lap" & this.CurrentLabel.ChildNodes.Count + 1 'this.CurrentLabel.NodeName & "_
newNode.LabelType = stp_LapTime

If this.CurrentLabel Is Nothing Then
Err.Description = "No test is currently running to write lap data to"
Err.Raise 5
Else
Set newNode.parentNode = this.CurrentLabel
this.CurrentLabel.ChildNodes.Add newNode, newNode.NodeName
End If


'Save time data to dictionary and return to execution
Dim dictKey As String
dictKey = this.CurrentLabel.Location & "_" & newNode.NodeName
this.data.Add dictKey, clockTimes
this.data(dictKey).TimeOut = MicroTimer
End Sub

Private Sub Class_Initialize()
Set this.data = CreateObject("Scripting.Dictionary")
End Sub



LabelTree Class



Each instance of a LabelTree object represents a node. Nodes are arranged in a tree fashion, with parent nodes and child nodes (equivalent to level of nesting of labels). The Enum facilitates different post-processing logic for lap labels vs everything else.



Option Explicit

Public Enum stopwatchLableType
stp_LapTime = 1
stp_Label
stp_Start
stp_Finish
End Enum

Private Type TLabelTree
parentNode As LabelTree
ChildNodes As Collection
NodeName As String
TimeSpent As Double
TimeWasted As Double 'time used by stopwatch runs
Location As String
LabelType As stopwatchLableType
End Type

Private this As TLabelTree
Public Property Get LabelType() As stopwatchLableType
LabelType = this.LabelType
End Property

Public Property Let LabelType(ByVal value As stopwatchLableType)
this.LabelType = value
End Property

Public Property Get Location() As String
Location = this.Location
End Property

Public Property Let Location(ByVal value As String)
this.Location = value
End Property

Public Property Get TimeSpent() As Double
TimeSpent = this.TimeSpent
End Property

Public Property Let TimeSpent(ByVal value As Double)
this.TimeSpent = value
End Property

Public Property Get TimeWasted() As Double
TimeWasted = this.TimeWasted
End Property

Public Property Let TimeWasted(ByVal value As Double)
this.TimeWasted = value
End Property

Public Property Get ChildNodes() As Collection
Set ChildNodes = this.ChildNodes
End Property

Public Property Set ChildNodes(ByVal value As Collection)
Set this.ChildNodes = value
End Property

Public Property Get NodeName() As String
NodeName = this.NodeName
End Property

Public Property Let NodeName(ByVal value As String)
this.NodeName = value
End Property

Public Property Get parentNode() As LabelTree
Set parentNode = this.parentNode
End Property

Public Property Set parentNode(ByVal value As LabelTree)
Set this.parentNode = value
End Property

Private Sub Class_Initialize()
Set this.ChildNodes = New Collection
End Sub



TimeInfo Class



Holds a timestamp. The only reason this is a Class and not a Type is because it has to be added to a dictionary.



Option Explicit

Private Type TTimeInfo
TimeIn As Double
TimeOut As Double
End Type

Private this As TTimeInfo

Public Property Get TimeIn() As Double
TimeIn = this.TimeIn
End Property

Public Property Let TimeIn(ByVal value As Double)
this.TimeIn = value
End Property

Public Property Get TimeOut() As Double
TimeOut = this.TimeOut
End Property

Public Property Let TimeOut(ByVal value As Double)
this.TimeOut = value
End Property



StopwatchResults Class



This class does all the post-processing of the labelTree. It converts raw timestamps into time differences using the logic outlined earlier. It also contains methods to output data. The exact implementation here is likely to change a lot - as I intend to expand the output formats to include .ToFile and .ToSheet. Also there may be some statistics built in for loops.



Option Explicit

Private Type TStopWatchResults
TimeData As Object
LabelData As LabelTree
End Type

Private this As TStopWatchResults

Public Sub LoadData(ByVal TimeData As Object, ByVal LabelData As LabelTree)
Set this.LabelData = LabelData
Set this.TimeData = TimeData
writeTimes this.LabelData
End Sub

Public Property Get ToLabelTree() As LabelTree
Set ToLabelTree = this.LabelData
End Property

Public Property Get RawData() As Object
Set RawData = this.TimeData
End Property

Public Sub ToImmediateWindow()
'Prints time info to immediate window
Dim resultsTree As LabelTree
Set resultsTree = this.LabelData
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
flattenTree resultsTree, dict
Debug.Print "Label name", "Time taken"
Debug.Print String(35, "-")
Dim value As Variant
For Each value In dict.Keys
Debug.Print value, dict(value)(0), dict(value)(1)
Next value
End Sub

Private Sub flattenTree(ByVal treeItem As LabelTree, ByRef dict As Object, Optional ByVal depth As Long = 0)
'recursively converts a results tree to a dictionary of result keys
dict.Add printf("0 1", treeItem.Location, treeItem.NodeName), Array(treeItem.TimeSpent, treeItem.TimeWasted)
If treeItem.ChildNodes.Count > 0 Then
Dim item As Variant
For Each item In treeItem.ChildNodes
flattenTree item, dict, depth + 1
Next
End If
End Sub

Private Sub writeTimes(ByRef labelItem As LabelTree)
'Recursively write absolute time data to time elapsed data

Dim startTimes As TimeInfo
Dim endTimes As TimeInfo

setTimeStamps labelItem, startTimes, endTimes 'get timestamps from dictionary
With labelItem
If .ChildNodes.Count > 0 Then
'has children, work out time spent for each then sum
Dim childLabel As LabelTree
Dim item As Variant

For Each item In .ChildNodes 'recurse deeper
Set childLabel = item
writeTimes childLabel
.TimeWasted = .TimeWasted + childLabel.TimeWasted 'add up child wasted time
Next item
.TimeSpent = endTimes.TimeIn - startTimes.TimeOut - .TimeWasted 'time diff - wasted time
.TimeWasted = .TimeWasted + endTimes.TimeOut - endTimes.TimeIn + startTimes.TimeOut - startTimes.TimeIn
Else 'No children
If .LabelType = stp_LapTime Then
.TimeWasted = endTimes.TimeOut - endTimes.TimeIn
Else 'find time stamps for opening and closing label
.TimeWasted = endTimes.TimeOut - endTimes.TimeIn + startTimes.TimeOut - startTimes.TimeIn
End If
.TimeSpent = endTimes.TimeIn - startTimes.TimeOut
End If
End With
End Sub

Private Sub setTimeStamps(ByVal labelItem As LabelTree, ByRef startTimes As TimeInfo, ByRef endTimes As TimeInfo)
'writes timestamps byref
With labelItem
Dim startKey As String
Dim endKey As String
'location of timestamps in dictionary
Select Case .LabelType
Case stp_LapTime
Dim keyBase As String
keyBase = .parentNode.Location
Dim lapNumber As Long
lapNumber = Right$(.NodeName, Len(.NodeName) - 3)
If lapNumber = 1 Then 'first lap, starts at
startKey = printf("0_open", keyBase)
Else
startKey = printf("0_Lap1", keyBase, lapNumber - 1) 'start at prev lap, end here
End If
endKey = printf("0_Lap1", keyBase, lapNumber)
Case Else
startKey = printf("0_open", .Location)
endKey = printf("0_close", .Location)
End Select
Set endTimes = this.TimeData(endKey)
Set startTimes = this.TimeData(startKey)
End With

End Sub

Private Function printf(ByVal mask As String, ParamArray tokens()) As String
'Format string with by substituting into mask - stackoverflow.com/a/17233834/6609896
Dim i As Long
For i = 0 To UBound(tokens)
mask = Replace$(mask, "" & i & "", tokens(i))
Next
printf = mask
End Function


My concerns



I would particularly like feedback on a few things:



  • Comments and names; I feel like comments are sparse, but maybe naming has made up for those ambiguities?

  • User Interface; particularly Labels

    • Is there a better name for open and close label to make it obvious what they do?

    • How about Laps, do they make sense?

    • I could have auto-closed all labels like I did with laps, would this have been cleaner? It would give less control over precisely which portions of code are measured.


  • ACCURACY. This is a major concern. I've tried to put everything the class does between 2 MicroTimers, so that class overhead can be subtracted from overall measured time. I ran some tests for loops under different conditions (fixed number of loops, sometimes calling routines in the loop, sometimes measuring time for individual loops) to compare my Stopwatch vs writing MicroTimer to a pre-dimensioned array. These are the results:

Results



Which are a bit cryptic. But essentially it compares Real - MicroTimer+Array times (overall and per lap) to Ck - Stopwatch times. And it shows that when the overhead of the class (Waste) is of the same order of magnitude as the running time for the test, the measurements for stopwatch are about 3-4 times longer than the Real measurements. This means that timings below a precision of 1E-4 ~ 100us are fairly inaccurate.



Can anyone see how to improve the accuracy?



Obviously any and all other feedback is welcome too.










share|improve this question











$endgroup$


















    3












    $begingroup$


    Intro



    Related, related



    I'm trying to come up with a neat, accurate way of timing VBA code, as I'm yet to find a method to do this in VBA directly (without plugins etc.)



    The general idea was to create some Stopwatch class which could be initialised at the start of a test procedure, then various markers could be dotted throughout the code under review and when execution reaches these markers, the stopwatch class makes a note of the time.



    To get an in-depth profile of code execution, I wanted to be able to differentiate between Main methods and Sub methods (ie if Sub Foo calls Sub A and Sub B, it would be nice to have stats for Foo, and beneath it, A and B individually). Another LabelTree class could be used to build up this hierarchy model.



    Finally a StopwatchResults class can hold methods required to turn raw timestamp data (held in TimeInfo classes) into execution times for different methods, and return that info in required formats (currently just printing or as a LabelTree object).



    Put that all together and you can write something like this:





    Sub testRoutine()
    Dim ck As New Stopwatch
    ck.Start
    ck.OpenLabel "HeavyWork"
    DoSomeHeavyWork
    ck.CloseLabel
    ck.OpenLabel "LoopTest"
    Dim i As Long
    For i = 1 To 5
    DoSomeHeavyWork 0.1
    ck.Lap
    Next i
    ck.CloseLabel
    ck.Finish
    ck.Results.ToImmediateWindow
    End Sub


    Which prints for example:



    Label name Time taken
    -----------------------------------
    1 Start 1.00116134128621 1.90410726645496E-03
    1.1 HeavyWork 0.500211852449866 2.6879100187216E-04
    1.2 LoopTest 0.500682749669068 1.43936557287816E-03
    1.2.1 Lap1 0.100088742066873 2.34935650951229E-04
    1.2.2 Lap2 0.100127727018844 2.38013410125859E-04
    1.2.3 Lap3 0.100125675184245 2.53402205999009E-04
    1.2.4 Lap4 0.100125675184245 2.53402205999009E-04
    1.2.5 Lap5 0.10012362334237 2.50324446824379E-04


    NB. DoSomeHeavyWork here was just a pause of length seconds



    Sub DoSomeHeavyWork(Optional length As Single = 0.5)
    Dim startTime As Single
    startTime = Timer
    Do Until Timer - startTime > length
    'DoEvents
    Loop
    End Sub


    Labels



    You can see how the test code makes use of labels to enclose portions of the code. Think of labels like brackets, you can OpenLabel and CloseLabel and partition the code into sections like that, the stopwatch measures time between the brackets.



    .Start and .Finish are just labels with default name, equivalent to .OpenLabel("Start") and .CloseLabel respectively.



    .Lap is a special kind of label. Rather than needing to open and close, laps are used to characterise loops. They measure time relative to the previous label (be it an openLabel/Start or another Laplabel)



    Nested labels are considered child nodes in the tree of hierarchy, so "HeavyWork" is a child of the "Start" label. Lap labels are special and can't have child nodes; i.e. you can't make a sub label within a lap measurement (behaviour which I may change, but can be worked around by using a normal label instead)



    With this bracket model the code becomes (Laps open and close their own brackets, except Lap1)



    Start(
    HeavyWork(
    )
    LoopTest(
    Lap1)
    (Lap2)
    (Lap3)
    (Lap4)
    (Lap5)
    )
    )


    How the timing works



    The idea was to ensure that the time recorded for a given run was independent of the presence of the stopwatch class. For that reason whenever the class is accessed, it mesures a time-in and a time-out (i.e., it times anything it does between receiving control and handing it back to the caller). This time is subtracted from overall execution time to reduce the impact of of the class on timing results.



    The time registered on a label is therefore:



    (Time into close label) - (Time out of open label) - (Time wasted by stopwatch class in all child nodes)


    Implementation



    To add all of these modules to a project at once, add and run the extract method of this compressed file. You'll need to allow programmatic access to the project




    Stopwatch class



    Class to generate label tree hierarchy (Start,OpenLabel,CloseLabel,Lap,Finish), and calculate timestamps (MicroTimer) at each label. These are stored in a dictionary using keys based on the location of a label within the tree



    Option Explicit

    Private Type TStopWatch
    data As Object
    CurrentLabel As LabelTree
    Results As StopwatchResults
    FirstLabel As LabelTree
    End Type

    Private this As TStopWatch

    Private Declare PtrSafe Function getFrequency Lib "kernel32" _
    Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    Private Declare PtrSafe Function getTickCount Lib "kernel32" _
    Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long

    Private Function MicroTimer() As Double
    'Accurate timing method - stackoverflow.com/a/7116928/6609896
    Dim cyTicks1 As Currency
    Static cyFrequency As Currency

    MicroTimer = 0

    If cyFrequency = 0 Then getFrequency cyFrequency

    getTickCount cyTicks1

    If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
    End Function

    Public Sub Start()
    OpenLabel "Start"
    End Sub

    Public Sub Finish()
    CloseLabel
    Set this.Results = New StopwatchResults
    this.Results.LoadData this.data, this.FirstLabel
    End Sub

    Public Property Get Results() As StopwatchResults
    Set Results = this.Results
    End Property

    Public Sub OpenLabel(ByVal labelName As String)
    'Save time on arrival
    Dim clockTimes As New TimeInfo
    clockTimes.TimeIn = MicroTimer

    'Define new label, and make it a child of the current label
    Dim newNode As New LabelTree
    newNode.NodeName = labelName
    If Not this.CurrentLabel Is Nothing Then
    Set newNode.parentNode = this.CurrentLabel
    '1.2.1 format
    newNode.Location = this.CurrentLabel.Location & "." & this.CurrentLabel.ChildNodes.Count + 1
    this.CurrentLabel.ChildNodes.Add newNode, newNode.Location & newNode.NodeName
    Else
    newNode.Location = "1"
    Set this.FirstLabel = newNode
    End If
    Set this.CurrentLabel = newNode

    'Save time data to dictionary and return to execution
    Dim dictKey As String
    dictKey = newNode.Location & "_open"
    this.data.Add dictKey, clockTimes
    this.data(dictKey).TimeOut = MicroTimer
    End Sub

    Public Sub CloseLabel()
    'Save time on arrival
    Dim clockTimes As New TimeInfo
    clockTimes.TimeIn = MicroTimer

    'Save time data to dictionary and return to execution
    Dim dictKey As String
    dictKey = this.CurrentLabel.Location & "_close"
    this.data.Add dictKey, clockTimes

    'Close label by setting to parent
    Set this.CurrentLabel = this.CurrentLabel.parentNode
    this.data(dictKey).TimeOut = MicroTimer
    End Sub

    Public Sub Lap()
    'Save time on arrival
    Dim clockTimes As New TimeInfo
    clockTimes.TimeIn = MicroTimer

    'Define new label, and make it a child of the current label
    Dim newNode As New LabelTree
    newNode.Location = this.CurrentLabel.Location & "." & this.CurrentLabel.ChildNodes.Count + 1
    newNode.NodeName = "Lap" & this.CurrentLabel.ChildNodes.Count + 1 'this.CurrentLabel.NodeName & "_
    newNode.LabelType = stp_LapTime

    If this.CurrentLabel Is Nothing Then
    Err.Description = "No test is currently running to write lap data to"
    Err.Raise 5
    Else
    Set newNode.parentNode = this.CurrentLabel
    this.CurrentLabel.ChildNodes.Add newNode, newNode.NodeName
    End If


    'Save time data to dictionary and return to execution
    Dim dictKey As String
    dictKey = this.CurrentLabel.Location & "_" & newNode.NodeName
    this.data.Add dictKey, clockTimes
    this.data(dictKey).TimeOut = MicroTimer
    End Sub

    Private Sub Class_Initialize()
    Set this.data = CreateObject("Scripting.Dictionary")
    End Sub



    LabelTree Class



    Each instance of a LabelTree object represents a node. Nodes are arranged in a tree fashion, with parent nodes and child nodes (equivalent to level of nesting of labels). The Enum facilitates different post-processing logic for lap labels vs everything else.



    Option Explicit

    Public Enum stopwatchLableType
    stp_LapTime = 1
    stp_Label
    stp_Start
    stp_Finish
    End Enum

    Private Type TLabelTree
    parentNode As LabelTree
    ChildNodes As Collection
    NodeName As String
    TimeSpent As Double
    TimeWasted As Double 'time used by stopwatch runs
    Location As String
    LabelType As stopwatchLableType
    End Type

    Private this As TLabelTree
    Public Property Get LabelType() As stopwatchLableType
    LabelType = this.LabelType
    End Property

    Public Property Let LabelType(ByVal value As stopwatchLableType)
    this.LabelType = value
    End Property

    Public Property Get Location() As String
    Location = this.Location
    End Property

    Public Property Let Location(ByVal value As String)
    this.Location = value
    End Property

    Public Property Get TimeSpent() As Double
    TimeSpent = this.TimeSpent
    End Property

    Public Property Let TimeSpent(ByVal value As Double)
    this.TimeSpent = value
    End Property

    Public Property Get TimeWasted() As Double
    TimeWasted = this.TimeWasted
    End Property

    Public Property Let TimeWasted(ByVal value As Double)
    this.TimeWasted = value
    End Property

    Public Property Get ChildNodes() As Collection
    Set ChildNodes = this.ChildNodes
    End Property

    Public Property Set ChildNodes(ByVal value As Collection)
    Set this.ChildNodes = value
    End Property

    Public Property Get NodeName() As String
    NodeName = this.NodeName
    End Property

    Public Property Let NodeName(ByVal value As String)
    this.NodeName = value
    End Property

    Public Property Get parentNode() As LabelTree
    Set parentNode = this.parentNode
    End Property

    Public Property Set parentNode(ByVal value As LabelTree)
    Set this.parentNode = value
    End Property

    Private Sub Class_Initialize()
    Set this.ChildNodes = New Collection
    End Sub



    TimeInfo Class



    Holds a timestamp. The only reason this is a Class and not a Type is because it has to be added to a dictionary.



    Option Explicit

    Private Type TTimeInfo
    TimeIn As Double
    TimeOut As Double
    End Type

    Private this As TTimeInfo

    Public Property Get TimeIn() As Double
    TimeIn = this.TimeIn
    End Property

    Public Property Let TimeIn(ByVal value As Double)
    this.TimeIn = value
    End Property

    Public Property Get TimeOut() As Double
    TimeOut = this.TimeOut
    End Property

    Public Property Let TimeOut(ByVal value As Double)
    this.TimeOut = value
    End Property



    StopwatchResults Class



    This class does all the post-processing of the labelTree. It converts raw timestamps into time differences using the logic outlined earlier. It also contains methods to output data. The exact implementation here is likely to change a lot - as I intend to expand the output formats to include .ToFile and .ToSheet. Also there may be some statistics built in for loops.



    Option Explicit

    Private Type TStopWatchResults
    TimeData As Object
    LabelData As LabelTree
    End Type

    Private this As TStopWatchResults

    Public Sub LoadData(ByVal TimeData As Object, ByVal LabelData As LabelTree)
    Set this.LabelData = LabelData
    Set this.TimeData = TimeData
    writeTimes this.LabelData
    End Sub

    Public Property Get ToLabelTree() As LabelTree
    Set ToLabelTree = this.LabelData
    End Property

    Public Property Get RawData() As Object
    Set RawData = this.TimeData
    End Property

    Public Sub ToImmediateWindow()
    'Prints time info to immediate window
    Dim resultsTree As LabelTree
    Set resultsTree = this.LabelData
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    flattenTree resultsTree, dict
    Debug.Print "Label name", "Time taken"
    Debug.Print String(35, "-")
    Dim value As Variant
    For Each value In dict.Keys
    Debug.Print value, dict(value)(0), dict(value)(1)
    Next value
    End Sub

    Private Sub flattenTree(ByVal treeItem As LabelTree, ByRef dict As Object, Optional ByVal depth As Long = 0)
    'recursively converts a results tree to a dictionary of result keys
    dict.Add printf("0 1", treeItem.Location, treeItem.NodeName), Array(treeItem.TimeSpent, treeItem.TimeWasted)
    If treeItem.ChildNodes.Count > 0 Then
    Dim item As Variant
    For Each item In treeItem.ChildNodes
    flattenTree item, dict, depth + 1
    Next
    End If
    End Sub

    Private Sub writeTimes(ByRef labelItem As LabelTree)
    'Recursively write absolute time data to time elapsed data

    Dim startTimes As TimeInfo
    Dim endTimes As TimeInfo

    setTimeStamps labelItem, startTimes, endTimes 'get timestamps from dictionary
    With labelItem
    If .ChildNodes.Count > 0 Then
    'has children, work out time spent for each then sum
    Dim childLabel As LabelTree
    Dim item As Variant

    For Each item In .ChildNodes 'recurse deeper
    Set childLabel = item
    writeTimes childLabel
    .TimeWasted = .TimeWasted + childLabel.TimeWasted 'add up child wasted time
    Next item
    .TimeSpent = endTimes.TimeIn - startTimes.TimeOut - .TimeWasted 'time diff - wasted time
    .TimeWasted = .TimeWasted + endTimes.TimeOut - endTimes.TimeIn + startTimes.TimeOut - startTimes.TimeIn
    Else 'No children
    If .LabelType = stp_LapTime Then
    .TimeWasted = endTimes.TimeOut - endTimes.TimeIn
    Else 'find time stamps for opening and closing label
    .TimeWasted = endTimes.TimeOut - endTimes.TimeIn + startTimes.TimeOut - startTimes.TimeIn
    End If
    .TimeSpent = endTimes.TimeIn - startTimes.TimeOut
    End If
    End With
    End Sub

    Private Sub setTimeStamps(ByVal labelItem As LabelTree, ByRef startTimes As TimeInfo, ByRef endTimes As TimeInfo)
    'writes timestamps byref
    With labelItem
    Dim startKey As String
    Dim endKey As String
    'location of timestamps in dictionary
    Select Case .LabelType
    Case stp_LapTime
    Dim keyBase As String
    keyBase = .parentNode.Location
    Dim lapNumber As Long
    lapNumber = Right$(.NodeName, Len(.NodeName) - 3)
    If lapNumber = 1 Then 'first lap, starts at
    startKey = printf("0_open", keyBase)
    Else
    startKey = printf("0_Lap1", keyBase, lapNumber - 1) 'start at prev lap, end here
    End If
    endKey = printf("0_Lap1", keyBase, lapNumber)
    Case Else
    startKey = printf("0_open", .Location)
    endKey = printf("0_close", .Location)
    End Select
    Set endTimes = this.TimeData(endKey)
    Set startTimes = this.TimeData(startKey)
    End With

    End Sub

    Private Function printf(ByVal mask As String, ParamArray tokens()) As String
    'Format string with by substituting into mask - stackoverflow.com/a/17233834/6609896
    Dim i As Long
    For i = 0 To UBound(tokens)
    mask = Replace$(mask, "" & i & "", tokens(i))
    Next
    printf = mask
    End Function


    My concerns



    I would particularly like feedback on a few things:



    • Comments and names; I feel like comments are sparse, but maybe naming has made up for those ambiguities?

    • User Interface; particularly Labels

      • Is there a better name for open and close label to make it obvious what they do?

      • How about Laps, do they make sense?

      • I could have auto-closed all labels like I did with laps, would this have been cleaner? It would give less control over precisely which portions of code are measured.


    • ACCURACY. This is a major concern. I've tried to put everything the class does between 2 MicroTimers, so that class overhead can be subtracted from overall measured time. I ran some tests for loops under different conditions (fixed number of loops, sometimes calling routines in the loop, sometimes measuring time for individual loops) to compare my Stopwatch vs writing MicroTimer to a pre-dimensioned array. These are the results:

    Results



    Which are a bit cryptic. But essentially it compares Real - MicroTimer+Array times (overall and per lap) to Ck - Stopwatch times. And it shows that when the overhead of the class (Waste) is of the same order of magnitude as the running time for the test, the measurements for stopwatch are about 3-4 times longer than the Real measurements. This means that timings below a precision of 1E-4 ~ 100us are fairly inaccurate.



    Can anyone see how to improve the accuracy?



    Obviously any and all other feedback is welcome too.










    share|improve this question











    $endgroup$














      3












      3








      3





      $begingroup$


      Intro



      Related, related



      I'm trying to come up with a neat, accurate way of timing VBA code, as I'm yet to find a method to do this in VBA directly (without plugins etc.)



      The general idea was to create some Stopwatch class which could be initialised at the start of a test procedure, then various markers could be dotted throughout the code under review and when execution reaches these markers, the stopwatch class makes a note of the time.



      To get an in-depth profile of code execution, I wanted to be able to differentiate between Main methods and Sub methods (ie if Sub Foo calls Sub A and Sub B, it would be nice to have stats for Foo, and beneath it, A and B individually). Another LabelTree class could be used to build up this hierarchy model.



      Finally a StopwatchResults class can hold methods required to turn raw timestamp data (held in TimeInfo classes) into execution times for different methods, and return that info in required formats (currently just printing or as a LabelTree object).



      Put that all together and you can write something like this:





      Sub testRoutine()
      Dim ck As New Stopwatch
      ck.Start
      ck.OpenLabel "HeavyWork"
      DoSomeHeavyWork
      ck.CloseLabel
      ck.OpenLabel "LoopTest"
      Dim i As Long
      For i = 1 To 5
      DoSomeHeavyWork 0.1
      ck.Lap
      Next i
      ck.CloseLabel
      ck.Finish
      ck.Results.ToImmediateWindow
      End Sub


      Which prints for example:



      Label name Time taken
      -----------------------------------
      1 Start 1.00116134128621 1.90410726645496E-03
      1.1 HeavyWork 0.500211852449866 2.6879100187216E-04
      1.2 LoopTest 0.500682749669068 1.43936557287816E-03
      1.2.1 Lap1 0.100088742066873 2.34935650951229E-04
      1.2.2 Lap2 0.100127727018844 2.38013410125859E-04
      1.2.3 Lap3 0.100125675184245 2.53402205999009E-04
      1.2.4 Lap4 0.100125675184245 2.53402205999009E-04
      1.2.5 Lap5 0.10012362334237 2.50324446824379E-04


      NB. DoSomeHeavyWork here was just a pause of length seconds



      Sub DoSomeHeavyWork(Optional length As Single = 0.5)
      Dim startTime As Single
      startTime = Timer
      Do Until Timer - startTime > length
      'DoEvents
      Loop
      End Sub


      Labels



      You can see how the test code makes use of labels to enclose portions of the code. Think of labels like brackets, you can OpenLabel and CloseLabel and partition the code into sections like that, the stopwatch measures time between the brackets.



      .Start and .Finish are just labels with default name, equivalent to .OpenLabel("Start") and .CloseLabel respectively.



      .Lap is a special kind of label. Rather than needing to open and close, laps are used to characterise loops. They measure time relative to the previous label (be it an openLabel/Start or another Laplabel)



      Nested labels are considered child nodes in the tree of hierarchy, so "HeavyWork" is a child of the "Start" label. Lap labels are special and can't have child nodes; i.e. you can't make a sub label within a lap measurement (behaviour which I may change, but can be worked around by using a normal label instead)



      With this bracket model the code becomes (Laps open and close their own brackets, except Lap1)



      Start(
      HeavyWork(
      )
      LoopTest(
      Lap1)
      (Lap2)
      (Lap3)
      (Lap4)
      (Lap5)
      )
      )


      How the timing works



      The idea was to ensure that the time recorded for a given run was independent of the presence of the stopwatch class. For that reason whenever the class is accessed, it mesures a time-in and a time-out (i.e., it times anything it does between receiving control and handing it back to the caller). This time is subtracted from overall execution time to reduce the impact of of the class on timing results.



      The time registered on a label is therefore:



      (Time into close label) - (Time out of open label) - (Time wasted by stopwatch class in all child nodes)


      Implementation



      To add all of these modules to a project at once, add and run the extract method of this compressed file. You'll need to allow programmatic access to the project




      Stopwatch class



      Class to generate label tree hierarchy (Start,OpenLabel,CloseLabel,Lap,Finish), and calculate timestamps (MicroTimer) at each label. These are stored in a dictionary using keys based on the location of a label within the tree



      Option Explicit

      Private Type TStopWatch
      data As Object
      CurrentLabel As LabelTree
      Results As StopwatchResults
      FirstLabel As LabelTree
      End Type

      Private this As TStopWatch

      Private Declare PtrSafe Function getFrequency Lib "kernel32" _
      Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
      Private Declare PtrSafe Function getTickCount Lib "kernel32" _
      Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long

      Private Function MicroTimer() As Double
      'Accurate timing method - stackoverflow.com/a/7116928/6609896
      Dim cyTicks1 As Currency
      Static cyFrequency As Currency

      MicroTimer = 0

      If cyFrequency = 0 Then getFrequency cyFrequency

      getTickCount cyTicks1

      If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
      End Function

      Public Sub Start()
      OpenLabel "Start"
      End Sub

      Public Sub Finish()
      CloseLabel
      Set this.Results = New StopwatchResults
      this.Results.LoadData this.data, this.FirstLabel
      End Sub

      Public Property Get Results() As StopwatchResults
      Set Results = this.Results
      End Property

      Public Sub OpenLabel(ByVal labelName As String)
      'Save time on arrival
      Dim clockTimes As New TimeInfo
      clockTimes.TimeIn = MicroTimer

      'Define new label, and make it a child of the current label
      Dim newNode As New LabelTree
      newNode.NodeName = labelName
      If Not this.CurrentLabel Is Nothing Then
      Set newNode.parentNode = this.CurrentLabel
      '1.2.1 format
      newNode.Location = this.CurrentLabel.Location & "." & this.CurrentLabel.ChildNodes.Count + 1
      this.CurrentLabel.ChildNodes.Add newNode, newNode.Location & newNode.NodeName
      Else
      newNode.Location = "1"
      Set this.FirstLabel = newNode
      End If
      Set this.CurrentLabel = newNode

      'Save time data to dictionary and return to execution
      Dim dictKey As String
      dictKey = newNode.Location & "_open"
      this.data.Add dictKey, clockTimes
      this.data(dictKey).TimeOut = MicroTimer
      End Sub

      Public Sub CloseLabel()
      'Save time on arrival
      Dim clockTimes As New TimeInfo
      clockTimes.TimeIn = MicroTimer

      'Save time data to dictionary and return to execution
      Dim dictKey As String
      dictKey = this.CurrentLabel.Location & "_close"
      this.data.Add dictKey, clockTimes

      'Close label by setting to parent
      Set this.CurrentLabel = this.CurrentLabel.parentNode
      this.data(dictKey).TimeOut = MicroTimer
      End Sub

      Public Sub Lap()
      'Save time on arrival
      Dim clockTimes As New TimeInfo
      clockTimes.TimeIn = MicroTimer

      'Define new label, and make it a child of the current label
      Dim newNode As New LabelTree
      newNode.Location = this.CurrentLabel.Location & "." & this.CurrentLabel.ChildNodes.Count + 1
      newNode.NodeName = "Lap" & this.CurrentLabel.ChildNodes.Count + 1 'this.CurrentLabel.NodeName & "_
      newNode.LabelType = stp_LapTime

      If this.CurrentLabel Is Nothing Then
      Err.Description = "No test is currently running to write lap data to"
      Err.Raise 5
      Else
      Set newNode.parentNode = this.CurrentLabel
      this.CurrentLabel.ChildNodes.Add newNode, newNode.NodeName
      End If


      'Save time data to dictionary and return to execution
      Dim dictKey As String
      dictKey = this.CurrentLabel.Location & "_" & newNode.NodeName
      this.data.Add dictKey, clockTimes
      this.data(dictKey).TimeOut = MicroTimer
      End Sub

      Private Sub Class_Initialize()
      Set this.data = CreateObject("Scripting.Dictionary")
      End Sub



      LabelTree Class



      Each instance of a LabelTree object represents a node. Nodes are arranged in a tree fashion, with parent nodes and child nodes (equivalent to level of nesting of labels). The Enum facilitates different post-processing logic for lap labels vs everything else.



      Option Explicit

      Public Enum stopwatchLableType
      stp_LapTime = 1
      stp_Label
      stp_Start
      stp_Finish
      End Enum

      Private Type TLabelTree
      parentNode As LabelTree
      ChildNodes As Collection
      NodeName As String
      TimeSpent As Double
      TimeWasted As Double 'time used by stopwatch runs
      Location As String
      LabelType As stopwatchLableType
      End Type

      Private this As TLabelTree
      Public Property Get LabelType() As stopwatchLableType
      LabelType = this.LabelType
      End Property

      Public Property Let LabelType(ByVal value As stopwatchLableType)
      this.LabelType = value
      End Property

      Public Property Get Location() As String
      Location = this.Location
      End Property

      Public Property Let Location(ByVal value As String)
      this.Location = value
      End Property

      Public Property Get TimeSpent() As Double
      TimeSpent = this.TimeSpent
      End Property

      Public Property Let TimeSpent(ByVal value As Double)
      this.TimeSpent = value
      End Property

      Public Property Get TimeWasted() As Double
      TimeWasted = this.TimeWasted
      End Property

      Public Property Let TimeWasted(ByVal value As Double)
      this.TimeWasted = value
      End Property

      Public Property Get ChildNodes() As Collection
      Set ChildNodes = this.ChildNodes
      End Property

      Public Property Set ChildNodes(ByVal value As Collection)
      Set this.ChildNodes = value
      End Property

      Public Property Get NodeName() As String
      NodeName = this.NodeName
      End Property

      Public Property Let NodeName(ByVal value As String)
      this.NodeName = value
      End Property

      Public Property Get parentNode() As LabelTree
      Set parentNode = this.parentNode
      End Property

      Public Property Set parentNode(ByVal value As LabelTree)
      Set this.parentNode = value
      End Property

      Private Sub Class_Initialize()
      Set this.ChildNodes = New Collection
      End Sub



      TimeInfo Class



      Holds a timestamp. The only reason this is a Class and not a Type is because it has to be added to a dictionary.



      Option Explicit

      Private Type TTimeInfo
      TimeIn As Double
      TimeOut As Double
      End Type

      Private this As TTimeInfo

      Public Property Get TimeIn() As Double
      TimeIn = this.TimeIn
      End Property

      Public Property Let TimeIn(ByVal value As Double)
      this.TimeIn = value
      End Property

      Public Property Get TimeOut() As Double
      TimeOut = this.TimeOut
      End Property

      Public Property Let TimeOut(ByVal value As Double)
      this.TimeOut = value
      End Property



      StopwatchResults Class



      This class does all the post-processing of the labelTree. It converts raw timestamps into time differences using the logic outlined earlier. It also contains methods to output data. The exact implementation here is likely to change a lot - as I intend to expand the output formats to include .ToFile and .ToSheet. Also there may be some statistics built in for loops.



      Option Explicit

      Private Type TStopWatchResults
      TimeData As Object
      LabelData As LabelTree
      End Type

      Private this As TStopWatchResults

      Public Sub LoadData(ByVal TimeData As Object, ByVal LabelData As LabelTree)
      Set this.LabelData = LabelData
      Set this.TimeData = TimeData
      writeTimes this.LabelData
      End Sub

      Public Property Get ToLabelTree() As LabelTree
      Set ToLabelTree = this.LabelData
      End Property

      Public Property Get RawData() As Object
      Set RawData = this.TimeData
      End Property

      Public Sub ToImmediateWindow()
      'Prints time info to immediate window
      Dim resultsTree As LabelTree
      Set resultsTree = this.LabelData
      Dim dict As Object
      Set dict = CreateObject("Scripting.Dictionary")
      flattenTree resultsTree, dict
      Debug.Print "Label name", "Time taken"
      Debug.Print String(35, "-")
      Dim value As Variant
      For Each value In dict.Keys
      Debug.Print value, dict(value)(0), dict(value)(1)
      Next value
      End Sub

      Private Sub flattenTree(ByVal treeItem As LabelTree, ByRef dict As Object, Optional ByVal depth As Long = 0)
      'recursively converts a results tree to a dictionary of result keys
      dict.Add printf("0 1", treeItem.Location, treeItem.NodeName), Array(treeItem.TimeSpent, treeItem.TimeWasted)
      If treeItem.ChildNodes.Count > 0 Then
      Dim item As Variant
      For Each item In treeItem.ChildNodes
      flattenTree item, dict, depth + 1
      Next
      End If
      End Sub

      Private Sub writeTimes(ByRef labelItem As LabelTree)
      'Recursively write absolute time data to time elapsed data

      Dim startTimes As TimeInfo
      Dim endTimes As TimeInfo

      setTimeStamps labelItem, startTimes, endTimes 'get timestamps from dictionary
      With labelItem
      If .ChildNodes.Count > 0 Then
      'has children, work out time spent for each then sum
      Dim childLabel As LabelTree
      Dim item As Variant

      For Each item In .ChildNodes 'recurse deeper
      Set childLabel = item
      writeTimes childLabel
      .TimeWasted = .TimeWasted + childLabel.TimeWasted 'add up child wasted time
      Next item
      .TimeSpent = endTimes.TimeIn - startTimes.TimeOut - .TimeWasted 'time diff - wasted time
      .TimeWasted = .TimeWasted + endTimes.TimeOut - endTimes.TimeIn + startTimes.TimeOut - startTimes.TimeIn
      Else 'No children
      If .LabelType = stp_LapTime Then
      .TimeWasted = endTimes.TimeOut - endTimes.TimeIn
      Else 'find time stamps for opening and closing label
      .TimeWasted = endTimes.TimeOut - endTimes.TimeIn + startTimes.TimeOut - startTimes.TimeIn
      End If
      .TimeSpent = endTimes.TimeIn - startTimes.TimeOut
      End If
      End With
      End Sub

      Private Sub setTimeStamps(ByVal labelItem As LabelTree, ByRef startTimes As TimeInfo, ByRef endTimes As TimeInfo)
      'writes timestamps byref
      With labelItem
      Dim startKey As String
      Dim endKey As String
      'location of timestamps in dictionary
      Select Case .LabelType
      Case stp_LapTime
      Dim keyBase As String
      keyBase = .parentNode.Location
      Dim lapNumber As Long
      lapNumber = Right$(.NodeName, Len(.NodeName) - 3)
      If lapNumber = 1 Then 'first lap, starts at
      startKey = printf("0_open", keyBase)
      Else
      startKey = printf("0_Lap1", keyBase, lapNumber - 1) 'start at prev lap, end here
      End If
      endKey = printf("0_Lap1", keyBase, lapNumber)
      Case Else
      startKey = printf("0_open", .Location)
      endKey = printf("0_close", .Location)
      End Select
      Set endTimes = this.TimeData(endKey)
      Set startTimes = this.TimeData(startKey)
      End With

      End Sub

      Private Function printf(ByVal mask As String, ParamArray tokens()) As String
      'Format string with by substituting into mask - stackoverflow.com/a/17233834/6609896
      Dim i As Long
      For i = 0 To UBound(tokens)
      mask = Replace$(mask, "" & i & "", tokens(i))
      Next
      printf = mask
      End Function


      My concerns



      I would particularly like feedback on a few things:



      • Comments and names; I feel like comments are sparse, but maybe naming has made up for those ambiguities?

      • User Interface; particularly Labels

        • Is there a better name for open and close label to make it obvious what they do?

        • How about Laps, do they make sense?

        • I could have auto-closed all labels like I did with laps, would this have been cleaner? It would give less control over precisely which portions of code are measured.


      • ACCURACY. This is a major concern. I've tried to put everything the class does between 2 MicroTimers, so that class overhead can be subtracted from overall measured time. I ran some tests for loops under different conditions (fixed number of loops, sometimes calling routines in the loop, sometimes measuring time for individual loops) to compare my Stopwatch vs writing MicroTimer to a pre-dimensioned array. These are the results:

      Results



      Which are a bit cryptic. But essentially it compares Real - MicroTimer+Array times (overall and per lap) to Ck - Stopwatch times. And it shows that when the overhead of the class (Waste) is of the same order of magnitude as the running time for the test, the measurements for stopwatch are about 3-4 times longer than the Real measurements. This means that timings below a precision of 1E-4 ~ 100us are fairly inaccurate.



      Can anyone see how to improve the accuracy?



      Obviously any and all other feedback is welcome too.










      share|improve this question











      $endgroup$




      Intro



      Related, related



      I'm trying to come up with a neat, accurate way of timing VBA code, as I'm yet to find a method to do this in VBA directly (without plugins etc.)



      The general idea was to create some Stopwatch class which could be initialised at the start of a test procedure, then various markers could be dotted throughout the code under review and when execution reaches these markers, the stopwatch class makes a note of the time.



      To get an in-depth profile of code execution, I wanted to be able to differentiate between Main methods and Sub methods (ie if Sub Foo calls Sub A and Sub B, it would be nice to have stats for Foo, and beneath it, A and B individually). Another LabelTree class could be used to build up this hierarchy model.



      Finally a StopwatchResults class can hold methods required to turn raw timestamp data (held in TimeInfo classes) into execution times for different methods, and return that info in required formats (currently just printing or as a LabelTree object).



      Put that all together and you can write something like this:





      Sub testRoutine()
      Dim ck As New Stopwatch
      ck.Start
      ck.OpenLabel "HeavyWork"
      DoSomeHeavyWork
      ck.CloseLabel
      ck.OpenLabel "LoopTest"
      Dim i As Long
      For i = 1 To 5
      DoSomeHeavyWork 0.1
      ck.Lap
      Next i
      ck.CloseLabel
      ck.Finish
      ck.Results.ToImmediateWindow
      End Sub


      Which prints for example:



      Label name Time taken
      -----------------------------------
      1 Start 1.00116134128621 1.90410726645496E-03
      1.1 HeavyWork 0.500211852449866 2.6879100187216E-04
      1.2 LoopTest 0.500682749669068 1.43936557287816E-03
      1.2.1 Lap1 0.100088742066873 2.34935650951229E-04
      1.2.2 Lap2 0.100127727018844 2.38013410125859E-04
      1.2.3 Lap3 0.100125675184245 2.53402205999009E-04
      1.2.4 Lap4 0.100125675184245 2.53402205999009E-04
      1.2.5 Lap5 0.10012362334237 2.50324446824379E-04


      NB. DoSomeHeavyWork here was just a pause of length seconds



      Sub DoSomeHeavyWork(Optional length As Single = 0.5)
      Dim startTime As Single
      startTime = Timer
      Do Until Timer - startTime > length
      'DoEvents
      Loop
      End Sub


      Labels



      You can see how the test code makes use of labels to enclose portions of the code. Think of labels like brackets, you can OpenLabel and CloseLabel and partition the code into sections like that, the stopwatch measures time between the brackets.



      .Start and .Finish are just labels with default name, equivalent to .OpenLabel("Start") and .CloseLabel respectively.



      .Lap is a special kind of label. Rather than needing to open and close, laps are used to characterise loops. They measure time relative to the previous label (be it an openLabel/Start or another Laplabel)



      Nested labels are considered child nodes in the tree of hierarchy, so "HeavyWork" is a child of the "Start" label. Lap labels are special and can't have child nodes; i.e. you can't make a sub label within a lap measurement (behaviour which I may change, but can be worked around by using a normal label instead)



      With this bracket model the code becomes (Laps open and close their own brackets, except Lap1)



      Start(
      HeavyWork(
      )
      LoopTest(
      Lap1)
      (Lap2)
      (Lap3)
      (Lap4)
      (Lap5)
      )
      )


      How the timing works



      The idea was to ensure that the time recorded for a given run was independent of the presence of the stopwatch class. For that reason whenever the class is accessed, it mesures a time-in and a time-out (i.e., it times anything it does between receiving control and handing it back to the caller). This time is subtracted from overall execution time to reduce the impact of of the class on timing results.



      The time registered on a label is therefore:



      (Time into close label) - (Time out of open label) - (Time wasted by stopwatch class in all child nodes)


      Implementation



      To add all of these modules to a project at once, add and run the extract method of this compressed file. You'll need to allow programmatic access to the project




      Stopwatch class



      Class to generate label tree hierarchy (Start,OpenLabel,CloseLabel,Lap,Finish), and calculate timestamps (MicroTimer) at each label. These are stored in a dictionary using keys based on the location of a label within the tree



      Option Explicit

      Private Type TStopWatch
      data As Object
      CurrentLabel As LabelTree
      Results As StopwatchResults
      FirstLabel As LabelTree
      End Type

      Private this As TStopWatch

      Private Declare PtrSafe Function getFrequency Lib "kernel32" _
      Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
      Private Declare PtrSafe Function getTickCount Lib "kernel32" _
      Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long

      Private Function MicroTimer() As Double
      'Accurate timing method - stackoverflow.com/a/7116928/6609896
      Dim cyTicks1 As Currency
      Static cyFrequency As Currency

      MicroTimer = 0

      If cyFrequency = 0 Then getFrequency cyFrequency

      getTickCount cyTicks1

      If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
      End Function

      Public Sub Start()
      OpenLabel "Start"
      End Sub

      Public Sub Finish()
      CloseLabel
      Set this.Results = New StopwatchResults
      this.Results.LoadData this.data, this.FirstLabel
      End Sub

      Public Property Get Results() As StopwatchResults
      Set Results = this.Results
      End Property

      Public Sub OpenLabel(ByVal labelName As String)
      'Save time on arrival
      Dim clockTimes As New TimeInfo
      clockTimes.TimeIn = MicroTimer

      'Define new label, and make it a child of the current label
      Dim newNode As New LabelTree
      newNode.NodeName = labelName
      If Not this.CurrentLabel Is Nothing Then
      Set newNode.parentNode = this.CurrentLabel
      '1.2.1 format
      newNode.Location = this.CurrentLabel.Location & "." & this.CurrentLabel.ChildNodes.Count + 1
      this.CurrentLabel.ChildNodes.Add newNode, newNode.Location & newNode.NodeName
      Else
      newNode.Location = "1"
      Set this.FirstLabel = newNode
      End If
      Set this.CurrentLabel = newNode

      'Save time data to dictionary and return to execution
      Dim dictKey As String
      dictKey = newNode.Location & "_open"
      this.data.Add dictKey, clockTimes
      this.data(dictKey).TimeOut = MicroTimer
      End Sub

      Public Sub CloseLabel()
      'Save time on arrival
      Dim clockTimes As New TimeInfo
      clockTimes.TimeIn = MicroTimer

      'Save time data to dictionary and return to execution
      Dim dictKey As String
      dictKey = this.CurrentLabel.Location & "_close"
      this.data.Add dictKey, clockTimes

      'Close label by setting to parent
      Set this.CurrentLabel = this.CurrentLabel.parentNode
      this.data(dictKey).TimeOut = MicroTimer
      End Sub

      Public Sub Lap()
      'Save time on arrival
      Dim clockTimes As New TimeInfo
      clockTimes.TimeIn = MicroTimer

      'Define new label, and make it a child of the current label
      Dim newNode As New LabelTree
      newNode.Location = this.CurrentLabel.Location & "." & this.CurrentLabel.ChildNodes.Count + 1
      newNode.NodeName = "Lap" & this.CurrentLabel.ChildNodes.Count + 1 'this.CurrentLabel.NodeName & "_
      newNode.LabelType = stp_LapTime

      If this.CurrentLabel Is Nothing Then
      Err.Description = "No test is currently running to write lap data to"
      Err.Raise 5
      Else
      Set newNode.parentNode = this.CurrentLabel
      this.CurrentLabel.ChildNodes.Add newNode, newNode.NodeName
      End If


      'Save time data to dictionary and return to execution
      Dim dictKey As String
      dictKey = this.CurrentLabel.Location & "_" & newNode.NodeName
      this.data.Add dictKey, clockTimes
      this.data(dictKey).TimeOut = MicroTimer
      End Sub

      Private Sub Class_Initialize()
      Set this.data = CreateObject("Scripting.Dictionary")
      End Sub



      LabelTree Class



      Each instance of a LabelTree object represents a node. Nodes are arranged in a tree fashion, with parent nodes and child nodes (equivalent to level of nesting of labels). The Enum facilitates different post-processing logic for lap labels vs everything else.



      Option Explicit

      Public Enum stopwatchLableType
      stp_LapTime = 1
      stp_Label
      stp_Start
      stp_Finish
      End Enum

      Private Type TLabelTree
      parentNode As LabelTree
      ChildNodes As Collection
      NodeName As String
      TimeSpent As Double
      TimeWasted As Double 'time used by stopwatch runs
      Location As String
      LabelType As stopwatchLableType
      End Type

      Private this As TLabelTree
      Public Property Get LabelType() As stopwatchLableType
      LabelType = this.LabelType
      End Property

      Public Property Let LabelType(ByVal value As stopwatchLableType)
      this.LabelType = value
      End Property

      Public Property Get Location() As String
      Location = this.Location
      End Property

      Public Property Let Location(ByVal value As String)
      this.Location = value
      End Property

      Public Property Get TimeSpent() As Double
      TimeSpent = this.TimeSpent
      End Property

      Public Property Let TimeSpent(ByVal value As Double)
      this.TimeSpent = value
      End Property

      Public Property Get TimeWasted() As Double
      TimeWasted = this.TimeWasted
      End Property

      Public Property Let TimeWasted(ByVal value As Double)
      this.TimeWasted = value
      End Property

      Public Property Get ChildNodes() As Collection
      Set ChildNodes = this.ChildNodes
      End Property

      Public Property Set ChildNodes(ByVal value As Collection)
      Set this.ChildNodes = value
      End Property

      Public Property Get NodeName() As String
      NodeName = this.NodeName
      End Property

      Public Property Let NodeName(ByVal value As String)
      this.NodeName = value
      End Property

      Public Property Get parentNode() As LabelTree
      Set parentNode = this.parentNode
      End Property

      Public Property Set parentNode(ByVal value As LabelTree)
      Set this.parentNode = value
      End Property

      Private Sub Class_Initialize()
      Set this.ChildNodes = New Collection
      End Sub



      TimeInfo Class



      Holds a timestamp. The only reason this is a Class and not a Type is because it has to be added to a dictionary.



      Option Explicit

      Private Type TTimeInfo
      TimeIn As Double
      TimeOut As Double
      End Type

      Private this As TTimeInfo

      Public Property Get TimeIn() As Double
      TimeIn = this.TimeIn
      End Property

      Public Property Let TimeIn(ByVal value As Double)
      this.TimeIn = value
      End Property

      Public Property Get TimeOut() As Double
      TimeOut = this.TimeOut
      End Property

      Public Property Let TimeOut(ByVal value As Double)
      this.TimeOut = value
      End Property



      StopwatchResults Class



      This class does all the post-processing of the labelTree. It converts raw timestamps into time differences using the logic outlined earlier. It also contains methods to output data. The exact implementation here is likely to change a lot - as I intend to expand the output formats to include .ToFile and .ToSheet. Also there may be some statistics built in for loops.



      Option Explicit

      Private Type TStopWatchResults
      TimeData As Object
      LabelData As LabelTree
      End Type

      Private this As TStopWatchResults

      Public Sub LoadData(ByVal TimeData As Object, ByVal LabelData As LabelTree)
      Set this.LabelData = LabelData
      Set this.TimeData = TimeData
      writeTimes this.LabelData
      End Sub

      Public Property Get ToLabelTree() As LabelTree
      Set ToLabelTree = this.LabelData
      End Property

      Public Property Get RawData() As Object
      Set RawData = this.TimeData
      End Property

      Public Sub ToImmediateWindow()
      'Prints time info to immediate window
      Dim resultsTree As LabelTree
      Set resultsTree = this.LabelData
      Dim dict As Object
      Set dict = CreateObject("Scripting.Dictionary")
      flattenTree resultsTree, dict
      Debug.Print "Label name", "Time taken"
      Debug.Print String(35, "-")
      Dim value As Variant
      For Each value In dict.Keys
      Debug.Print value, dict(value)(0), dict(value)(1)
      Next value
      End Sub

      Private Sub flattenTree(ByVal treeItem As LabelTree, ByRef dict As Object, Optional ByVal depth As Long = 0)
      'recursively converts a results tree to a dictionary of result keys
      dict.Add printf("0 1", treeItem.Location, treeItem.NodeName), Array(treeItem.TimeSpent, treeItem.TimeWasted)
      If treeItem.ChildNodes.Count > 0 Then
      Dim item As Variant
      For Each item In treeItem.ChildNodes
      flattenTree item, dict, depth + 1
      Next
      End If
      End Sub

      Private Sub writeTimes(ByRef labelItem As LabelTree)
      'Recursively write absolute time data to time elapsed data

      Dim startTimes As TimeInfo
      Dim endTimes As TimeInfo

      setTimeStamps labelItem, startTimes, endTimes 'get timestamps from dictionary
      With labelItem
      If .ChildNodes.Count > 0 Then
      'has children, work out time spent for each then sum
      Dim childLabel As LabelTree
      Dim item As Variant

      For Each item In .ChildNodes 'recurse deeper
      Set childLabel = item
      writeTimes childLabel
      .TimeWasted = .TimeWasted + childLabel.TimeWasted 'add up child wasted time
      Next item
      .TimeSpent = endTimes.TimeIn - startTimes.TimeOut - .TimeWasted 'time diff - wasted time
      .TimeWasted = .TimeWasted + endTimes.TimeOut - endTimes.TimeIn + startTimes.TimeOut - startTimes.TimeIn
      Else 'No children
      If .LabelType = stp_LapTime Then
      .TimeWasted = endTimes.TimeOut - endTimes.TimeIn
      Else 'find time stamps for opening and closing label
      .TimeWasted = endTimes.TimeOut - endTimes.TimeIn + startTimes.TimeOut - startTimes.TimeIn
      End If
      .TimeSpent = endTimes.TimeIn - startTimes.TimeOut
      End If
      End With
      End Sub

      Private Sub setTimeStamps(ByVal labelItem As LabelTree, ByRef startTimes As TimeInfo, ByRef endTimes As TimeInfo)
      'writes timestamps byref
      With labelItem
      Dim startKey As String
      Dim endKey As String
      'location of timestamps in dictionary
      Select Case .LabelType
      Case stp_LapTime
      Dim keyBase As String
      keyBase = .parentNode.Location
      Dim lapNumber As Long
      lapNumber = Right$(.NodeName, Len(.NodeName) - 3)
      If lapNumber = 1 Then 'first lap, starts at
      startKey = printf("0_open", keyBase)
      Else
      startKey = printf("0_Lap1", keyBase, lapNumber - 1) 'start at prev lap, end here
      End If
      endKey = printf("0_Lap1", keyBase, lapNumber)
      Case Else
      startKey = printf("0_open", .Location)
      endKey = printf("0_close", .Location)
      End Select
      Set endTimes = this.TimeData(endKey)
      Set startTimes = this.TimeData(startKey)
      End With

      End Sub

      Private Function printf(ByVal mask As String, ParamArray tokens()) As String
      'Format string with by substituting into mask - stackoverflow.com/a/17233834/6609896
      Dim i As Long
      For i = 0 To UBound(tokens)
      mask = Replace$(mask, "" & i & "", tokens(i))
      Next
      printf = mask
      End Function


      My concerns



      I would particularly like feedback on a few things:



      • Comments and names; I feel like comments are sparse, but maybe naming has made up for those ambiguities?

      • User Interface; particularly Labels

        • Is there a better name for open and close label to make it obvious what they do?

        • How about Laps, do they make sense?

        • I could have auto-closed all labels like I did with laps, would this have been cleaner? It would give less control over precisely which portions of code are measured.


      • ACCURACY. This is a major concern. I've tried to put everything the class does between 2 MicroTimers, so that class overhead can be subtracted from overall measured time. I ran some tests for loops under different conditions (fixed number of loops, sometimes calling routines in the loop, sometimes measuring time for individual loops) to compare my Stopwatch vs writing MicroTimer to a pre-dimensioned array. These are the results:

      Results



      Which are a bit cryptic. But essentially it compares Real - MicroTimer+Array times (overall and per lap) to Ck - Stopwatch times. And it shows that when the overhead of the class (Waste) is of the same order of magnitude as the running time for the test, the measurements for stopwatch are about 3-4 times longer than the Real measurements. This means that timings below a precision of 1E-4 ~ 100us are fairly inaccurate.



      Can anyone see how to improve the accuracy?



      Obviously any and all other feedback is welcome too.







      performance vba timer benchmarking






      share|improve this question















      share|improve this question













      share|improve this question




      share|improve this question








      edited 15 mins ago







      Greedo

















      asked May 21 '18 at 9:53









      GreedoGreedo

      366417




      366417




















          1 Answer
          1






          active

          oldest

          votes


















          1












          $begingroup$

          I don't know how useful this review will be as a review, but I want to write it up anyway.




          Re:




          • How about Laps, do they make sense?

          • I could have auto-closed all labels like I did with laps, would this have been cleaner? It would give less control over precisely which
            portions of code are measured.



          The way you handle the Lap appears to make it impossible for a Lap node to have a child node. If you put any labels inside a Lap, the stopwatch doesn't add a node to the Lap node, it just adds another node to the Start node.



          I haven't quite figured out exactly what is happening, I just know at a certain point in setTimeStamps (recursed down) the startKey that it's looking for to set startTimes doesn't exist. I think I'm in over my head, I'll try some pictures -



          Here it looks for 1Lap_2



          enter image description here



          But here you'll see that doesn't exist, it went from Lap1 to Lap3



          enter image description here




          The code that did this is



          Option Explicit

          Sub test()
          Dim clock As New Stopwatch
          clock.Start
          Dim i As Long
          For i = 1 To 10
          clock.Lap
          testMe clock, "label " & i
          Next
          clock.Finish
          clock.Results.ToImmediateWindow
          End Sub

          Sub testMe(ByRef clock As Stopwatch, ByVal label As String)
          clock.OpenLabel label
          'clock.Lap
          SaySomething label
          clock.CloseLabel
          End Sub

          Sub SaySomething(ByVal label As String)
          MsgBox label
          End Sub


          If you remove the Clock.Lap in the For loop and un-comment the Clock.Lap in TestMe it works fine.



          I was just passing the clock around some procedures, but this will occur in a very simple setup as well -



          Sub Test2()
          Dim clock As New Stopwatch
          clock.Start
          Dim i As Long
          For i = 1 To 3
          clock.Lap
          clock.OpenLabel i
          MsgBox i
          clock.CloseLabel
          Next
          clock.Finish
          End Sub


          And the error occurs on the Clock.Finish.



          Oh, and that extract method is nearly the coolest thing I've seen in VBA.






          share|improve this answer









          $endgroup$












          • $begingroup$
            Good spot. It's true that lap labels don't support child nodes. That's because their non standard format makes it a little more complicated to determine which nodes are children and which are siblings. But I think they're a little pointless if I don't add this behaviour in? Either way the workaround is to have an open and close pair in the loop instead. I also notice you put lap at the start of the loop - lap measurements are currently relative to the previous label (the lap ends when you hit the lap label) - I imagine a coach with a stopwatch can tell you the lap time only at the end.
            $endgroup$
            – Greedo
            May 22 '18 at 10:12










          • $begingroup$
            But perhaps measuring relative to the next label (putting lap at the start of the loop) is more intuitive - as you have naturally done. What do you think? I envisage a public stopwatch, perhaps predeclared (default instance attribute) and in personal.xlsb to avoid all the passing around. But then a reset method would be necessary.
            $endgroup$
            – Greedo
            May 22 '18 at 10:17










          • $begingroup$
            PS thanks, the code for compressing projects into a single module seems to be working well, although it won't work with userforms yet. Still early bound and very ugly, but it's next on my list of stuff to finish and maybe post here for a review ;-) I gotta say I think it's pretty swanky
            $endgroup$
            – Greedo
            May 22 '18 at 10:22










          • $begingroup$
            Right, I'm not sure how else the Lap would make sense, I think it's more of an error catching case. I think lap does make sense at the beginning of the loop, like a start lap since your lap didn't start on start.
            $endgroup$
            – Raystafarian
            May 23 '18 at 23:51











          Your Answer






          StackExchange.ifUsing("editor", function ()
          StackExchange.using("externalEditor", function ()
          StackExchange.using("snippets", function ()
          StackExchange.snippets.init();
          );
          );
          , "code-snippets");

          StackExchange.ready(function()
          var channelOptions =
          tags: "".split(" "),
          id: "196"
          ;
          initTagRenderer("".split(" "), "".split(" "), channelOptions);

          StackExchange.using("externalEditor", function()
          // Have to fire editor after snippets, if snippets enabled
          if (StackExchange.settings.snippets.snippetsEnabled)
          StackExchange.using("snippets", function()
          createEditor();
          );

          else
          createEditor();

          );

          function createEditor()
          StackExchange.prepareEditor(
          heartbeatType: 'answer',
          autoActivateHeartbeat: false,
          convertImagesToLinks: false,
          noModals: true,
          showLowRepImageUploadWarning: true,
          reputationToPostImages: null,
          bindNavPrevention: true,
          postfix: "",
          imageUploader:
          brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
          contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
          allowUrls: true
          ,
          onDemand: true,
          discardSelector: ".discard-answer"
          ,immediatelyShowMarkdownHelp:true
          );



          );













          draft saved

          draft discarded


















          StackExchange.ready(
          function ()
          StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fcodereview.stackexchange.com%2fquestions%2f194859%2fa-rather-accurate-vba-stopwatch%23new-answer', 'question_page');

          );

          Post as a guest















          Required, but never shown

























          1 Answer
          1






          active

          oldest

          votes








          1 Answer
          1






          active

          oldest

          votes









          active

          oldest

          votes






          active

          oldest

          votes









          1












          $begingroup$

          I don't know how useful this review will be as a review, but I want to write it up anyway.




          Re:




          • How about Laps, do they make sense?

          • I could have auto-closed all labels like I did with laps, would this have been cleaner? It would give less control over precisely which
            portions of code are measured.



          The way you handle the Lap appears to make it impossible for a Lap node to have a child node. If you put any labels inside a Lap, the stopwatch doesn't add a node to the Lap node, it just adds another node to the Start node.



          I haven't quite figured out exactly what is happening, I just know at a certain point in setTimeStamps (recursed down) the startKey that it's looking for to set startTimes doesn't exist. I think I'm in over my head, I'll try some pictures -



          Here it looks for 1Lap_2



          enter image description here



          But here you'll see that doesn't exist, it went from Lap1 to Lap3



          enter image description here




          The code that did this is



          Option Explicit

          Sub test()
          Dim clock As New Stopwatch
          clock.Start
          Dim i As Long
          For i = 1 To 10
          clock.Lap
          testMe clock, "label " & i
          Next
          clock.Finish
          clock.Results.ToImmediateWindow
          End Sub

          Sub testMe(ByRef clock As Stopwatch, ByVal label As String)
          clock.OpenLabel label
          'clock.Lap
          SaySomething label
          clock.CloseLabel
          End Sub

          Sub SaySomething(ByVal label As String)
          MsgBox label
          End Sub


          If you remove the Clock.Lap in the For loop and un-comment the Clock.Lap in TestMe it works fine.



          I was just passing the clock around some procedures, but this will occur in a very simple setup as well -



          Sub Test2()
          Dim clock As New Stopwatch
          clock.Start
          Dim i As Long
          For i = 1 To 3
          clock.Lap
          clock.OpenLabel i
          MsgBox i
          clock.CloseLabel
          Next
          clock.Finish
          End Sub


          And the error occurs on the Clock.Finish.



          Oh, and that extract method is nearly the coolest thing I've seen in VBA.






          share|improve this answer









          $endgroup$












          • $begingroup$
            Good spot. It's true that lap labels don't support child nodes. That's because their non standard format makes it a little more complicated to determine which nodes are children and which are siblings. But I think they're a little pointless if I don't add this behaviour in? Either way the workaround is to have an open and close pair in the loop instead. I also notice you put lap at the start of the loop - lap measurements are currently relative to the previous label (the lap ends when you hit the lap label) - I imagine a coach with a stopwatch can tell you the lap time only at the end.
            $endgroup$
            – Greedo
            May 22 '18 at 10:12










          • $begingroup$
            But perhaps measuring relative to the next label (putting lap at the start of the loop) is more intuitive - as you have naturally done. What do you think? I envisage a public stopwatch, perhaps predeclared (default instance attribute) and in personal.xlsb to avoid all the passing around. But then a reset method would be necessary.
            $endgroup$
            – Greedo
            May 22 '18 at 10:17










          • $begingroup$
            PS thanks, the code for compressing projects into a single module seems to be working well, although it won't work with userforms yet. Still early bound and very ugly, but it's next on my list of stuff to finish and maybe post here for a review ;-) I gotta say I think it's pretty swanky
            $endgroup$
            – Greedo
            May 22 '18 at 10:22










          • $begingroup$
            Right, I'm not sure how else the Lap would make sense, I think it's more of an error catching case. I think lap does make sense at the beginning of the loop, like a start lap since your lap didn't start on start.
            $endgroup$
            – Raystafarian
            May 23 '18 at 23:51















          1












          $begingroup$

          I don't know how useful this review will be as a review, but I want to write it up anyway.




          Re:




          • How about Laps, do they make sense?

          • I could have auto-closed all labels like I did with laps, would this have been cleaner? It would give less control over precisely which
            portions of code are measured.



          The way you handle the Lap appears to make it impossible for a Lap node to have a child node. If you put any labels inside a Lap, the stopwatch doesn't add a node to the Lap node, it just adds another node to the Start node.



          I haven't quite figured out exactly what is happening, I just know at a certain point in setTimeStamps (recursed down) the startKey that it's looking for to set startTimes doesn't exist. I think I'm in over my head, I'll try some pictures -



          Here it looks for 1Lap_2



          enter image description here



          But here you'll see that doesn't exist, it went from Lap1 to Lap3



          enter image description here




          The code that did this is



          Option Explicit

          Sub test()
          Dim clock As New Stopwatch
          clock.Start
          Dim i As Long
          For i = 1 To 10
          clock.Lap
          testMe clock, "label " & i
          Next
          clock.Finish
          clock.Results.ToImmediateWindow
          End Sub

          Sub testMe(ByRef clock As Stopwatch, ByVal label As String)
          clock.OpenLabel label
          'clock.Lap
          SaySomething label
          clock.CloseLabel
          End Sub

          Sub SaySomething(ByVal label As String)
          MsgBox label
          End Sub


          If you remove the Clock.Lap in the For loop and un-comment the Clock.Lap in TestMe it works fine.



          I was just passing the clock around some procedures, but this will occur in a very simple setup as well -



          Sub Test2()
          Dim clock As New Stopwatch
          clock.Start
          Dim i As Long
          For i = 1 To 3
          clock.Lap
          clock.OpenLabel i
          MsgBox i
          clock.CloseLabel
          Next
          clock.Finish
          End Sub


          And the error occurs on the Clock.Finish.



          Oh, and that extract method is nearly the coolest thing I've seen in VBA.






          share|improve this answer









          $endgroup$












          • $begingroup$
            Good spot. It's true that lap labels don't support child nodes. That's because their non standard format makes it a little more complicated to determine which nodes are children and which are siblings. But I think they're a little pointless if I don't add this behaviour in? Either way the workaround is to have an open and close pair in the loop instead. I also notice you put lap at the start of the loop - lap measurements are currently relative to the previous label (the lap ends when you hit the lap label) - I imagine a coach with a stopwatch can tell you the lap time only at the end.
            $endgroup$
            – Greedo
            May 22 '18 at 10:12










          • $begingroup$
            But perhaps measuring relative to the next label (putting lap at the start of the loop) is more intuitive - as you have naturally done. What do you think? I envisage a public stopwatch, perhaps predeclared (default instance attribute) and in personal.xlsb to avoid all the passing around. But then a reset method would be necessary.
            $endgroup$
            – Greedo
            May 22 '18 at 10:17










          • $begingroup$
            PS thanks, the code for compressing projects into a single module seems to be working well, although it won't work with userforms yet. Still early bound and very ugly, but it's next on my list of stuff to finish and maybe post here for a review ;-) I gotta say I think it's pretty swanky
            $endgroup$
            – Greedo
            May 22 '18 at 10:22










          • $begingroup$
            Right, I'm not sure how else the Lap would make sense, I think it's more of an error catching case. I think lap does make sense at the beginning of the loop, like a start lap since your lap didn't start on start.
            $endgroup$
            – Raystafarian
            May 23 '18 at 23:51













          1












          1








          1





          $begingroup$

          I don't know how useful this review will be as a review, but I want to write it up anyway.




          Re:




          • How about Laps, do they make sense?

          • I could have auto-closed all labels like I did with laps, would this have been cleaner? It would give less control over precisely which
            portions of code are measured.



          The way you handle the Lap appears to make it impossible for a Lap node to have a child node. If you put any labels inside a Lap, the stopwatch doesn't add a node to the Lap node, it just adds another node to the Start node.



          I haven't quite figured out exactly what is happening, I just know at a certain point in setTimeStamps (recursed down) the startKey that it's looking for to set startTimes doesn't exist. I think I'm in over my head, I'll try some pictures -



          Here it looks for 1Lap_2



          enter image description here



          But here you'll see that doesn't exist, it went from Lap1 to Lap3



          enter image description here




          The code that did this is



          Option Explicit

          Sub test()
          Dim clock As New Stopwatch
          clock.Start
          Dim i As Long
          For i = 1 To 10
          clock.Lap
          testMe clock, "label " & i
          Next
          clock.Finish
          clock.Results.ToImmediateWindow
          End Sub

          Sub testMe(ByRef clock As Stopwatch, ByVal label As String)
          clock.OpenLabel label
          'clock.Lap
          SaySomething label
          clock.CloseLabel
          End Sub

          Sub SaySomething(ByVal label As String)
          MsgBox label
          End Sub


          If you remove the Clock.Lap in the For loop and un-comment the Clock.Lap in TestMe it works fine.



          I was just passing the clock around some procedures, but this will occur in a very simple setup as well -



          Sub Test2()
          Dim clock As New Stopwatch
          clock.Start
          Dim i As Long
          For i = 1 To 3
          clock.Lap
          clock.OpenLabel i
          MsgBox i
          clock.CloseLabel
          Next
          clock.Finish
          End Sub


          And the error occurs on the Clock.Finish.



          Oh, and that extract method is nearly the coolest thing I've seen in VBA.






          share|improve this answer









          $endgroup$



          I don't know how useful this review will be as a review, but I want to write it up anyway.




          Re:




          • How about Laps, do they make sense?

          • I could have auto-closed all labels like I did with laps, would this have been cleaner? It would give less control over precisely which
            portions of code are measured.



          The way you handle the Lap appears to make it impossible for a Lap node to have a child node. If you put any labels inside a Lap, the stopwatch doesn't add a node to the Lap node, it just adds another node to the Start node.



          I haven't quite figured out exactly what is happening, I just know at a certain point in setTimeStamps (recursed down) the startKey that it's looking for to set startTimes doesn't exist. I think I'm in over my head, I'll try some pictures -



          Here it looks for 1Lap_2



          enter image description here



          But here you'll see that doesn't exist, it went from Lap1 to Lap3



          enter image description here




          The code that did this is



          Option Explicit

          Sub test()
          Dim clock As New Stopwatch
          clock.Start
          Dim i As Long
          For i = 1 To 10
          clock.Lap
          testMe clock, "label " & i
          Next
          clock.Finish
          clock.Results.ToImmediateWindow
          End Sub

          Sub testMe(ByRef clock As Stopwatch, ByVal label As String)
          clock.OpenLabel label
          'clock.Lap
          SaySomething label
          clock.CloseLabel
          End Sub

          Sub SaySomething(ByVal label As String)
          MsgBox label
          End Sub


          If you remove the Clock.Lap in the For loop and un-comment the Clock.Lap in TestMe it works fine.



          I was just passing the clock around some procedures, but this will occur in a very simple setup as well -



          Sub Test2()
          Dim clock As New Stopwatch
          clock.Start
          Dim i As Long
          For i = 1 To 3
          clock.Lap
          clock.OpenLabel i
          MsgBox i
          clock.CloseLabel
          Next
          clock.Finish
          End Sub


          And the error occurs on the Clock.Finish.



          Oh, and that extract method is nearly the coolest thing I've seen in VBA.







          share|improve this answer












          share|improve this answer



          share|improve this answer










          answered May 22 '18 at 4:05









          RaystafarianRaystafarian

          5,86911049




          5,86911049











          • $begingroup$
            Good spot. It's true that lap labels don't support child nodes. That's because their non standard format makes it a little more complicated to determine which nodes are children and which are siblings. But I think they're a little pointless if I don't add this behaviour in? Either way the workaround is to have an open and close pair in the loop instead. I also notice you put lap at the start of the loop - lap measurements are currently relative to the previous label (the lap ends when you hit the lap label) - I imagine a coach with a stopwatch can tell you the lap time only at the end.
            $endgroup$
            – Greedo
            May 22 '18 at 10:12










          • $begingroup$
            But perhaps measuring relative to the next label (putting lap at the start of the loop) is more intuitive - as you have naturally done. What do you think? I envisage a public stopwatch, perhaps predeclared (default instance attribute) and in personal.xlsb to avoid all the passing around. But then a reset method would be necessary.
            $endgroup$
            – Greedo
            May 22 '18 at 10:17










          • $begingroup$
            PS thanks, the code for compressing projects into a single module seems to be working well, although it won't work with userforms yet. Still early bound and very ugly, but it's next on my list of stuff to finish and maybe post here for a review ;-) I gotta say I think it's pretty swanky
            $endgroup$
            – Greedo
            May 22 '18 at 10:22










          • $begingroup$
            Right, I'm not sure how else the Lap would make sense, I think it's more of an error catching case. I think lap does make sense at the beginning of the loop, like a start lap since your lap didn't start on start.
            $endgroup$
            – Raystafarian
            May 23 '18 at 23:51
















          • $begingroup$
            Good spot. It's true that lap labels don't support child nodes. That's because their non standard format makes it a little more complicated to determine which nodes are children and which are siblings. But I think they're a little pointless if I don't add this behaviour in? Either way the workaround is to have an open and close pair in the loop instead. I also notice you put lap at the start of the loop - lap measurements are currently relative to the previous label (the lap ends when you hit the lap label) - I imagine a coach with a stopwatch can tell you the lap time only at the end.
            $endgroup$
            – Greedo
            May 22 '18 at 10:12










          • $begingroup$
            But perhaps measuring relative to the next label (putting lap at the start of the loop) is more intuitive - as you have naturally done. What do you think? I envisage a public stopwatch, perhaps predeclared (default instance attribute) and in personal.xlsb to avoid all the passing around. But then a reset method would be necessary.
            $endgroup$
            – Greedo
            May 22 '18 at 10:17










          • $begingroup$
            PS thanks, the code for compressing projects into a single module seems to be working well, although it won't work with userforms yet. Still early bound and very ugly, but it's next on my list of stuff to finish and maybe post here for a review ;-) I gotta say I think it's pretty swanky
            $endgroup$
            – Greedo
            May 22 '18 at 10:22










          • $begingroup$
            Right, I'm not sure how else the Lap would make sense, I think it's more of an error catching case. I think lap does make sense at the beginning of the loop, like a start lap since your lap didn't start on start.
            $endgroup$
            – Raystafarian
            May 23 '18 at 23:51















          $begingroup$
          Good spot. It's true that lap labels don't support child nodes. That's because their non standard format makes it a little more complicated to determine which nodes are children and which are siblings. But I think they're a little pointless if I don't add this behaviour in? Either way the workaround is to have an open and close pair in the loop instead. I also notice you put lap at the start of the loop - lap measurements are currently relative to the previous label (the lap ends when you hit the lap label) - I imagine a coach with a stopwatch can tell you the lap time only at the end.
          $endgroup$
          – Greedo
          May 22 '18 at 10:12




          $begingroup$
          Good spot. It's true that lap labels don't support child nodes. That's because their non standard format makes it a little more complicated to determine which nodes are children and which are siblings. But I think they're a little pointless if I don't add this behaviour in? Either way the workaround is to have an open and close pair in the loop instead. I also notice you put lap at the start of the loop - lap measurements are currently relative to the previous label (the lap ends when you hit the lap label) - I imagine a coach with a stopwatch can tell you the lap time only at the end.
          $endgroup$
          – Greedo
          May 22 '18 at 10:12












          $begingroup$
          But perhaps measuring relative to the next label (putting lap at the start of the loop) is more intuitive - as you have naturally done. What do you think? I envisage a public stopwatch, perhaps predeclared (default instance attribute) and in personal.xlsb to avoid all the passing around. But then a reset method would be necessary.
          $endgroup$
          – Greedo
          May 22 '18 at 10:17




          $begingroup$
          But perhaps measuring relative to the next label (putting lap at the start of the loop) is more intuitive - as you have naturally done. What do you think? I envisage a public stopwatch, perhaps predeclared (default instance attribute) and in personal.xlsb to avoid all the passing around. But then a reset method would be necessary.
          $endgroup$
          – Greedo
          May 22 '18 at 10:17












          $begingroup$
          PS thanks, the code for compressing projects into a single module seems to be working well, although it won't work with userforms yet. Still early bound and very ugly, but it's next on my list of stuff to finish and maybe post here for a review ;-) I gotta say I think it's pretty swanky
          $endgroup$
          – Greedo
          May 22 '18 at 10:22




          $begingroup$
          PS thanks, the code for compressing projects into a single module seems to be working well, although it won't work with userforms yet. Still early bound and very ugly, but it's next on my list of stuff to finish and maybe post here for a review ;-) I gotta say I think it's pretty swanky
          $endgroup$
          – Greedo
          May 22 '18 at 10:22












          $begingroup$
          Right, I'm not sure how else the Lap would make sense, I think it's more of an error catching case. I think lap does make sense at the beginning of the loop, like a start lap since your lap didn't start on start.
          $endgroup$
          – Raystafarian
          May 23 '18 at 23:51




          $begingroup$
          Right, I'm not sure how else the Lap would make sense, I think it's more of an error catching case. I think lap does make sense at the beginning of the loop, like a start lap since your lap didn't start on start.
          $endgroup$
          – Raystafarian
          May 23 '18 at 23:51

















          draft saved

          draft discarded
















































          Thanks for contributing an answer to Code Review Stack Exchange!


          • Please be sure to answer the question. Provide details and share your research!

          But avoid


          • Asking for help, clarification, or responding to other answers.

          • Making statements based on opinion; back them up with references or personal experience.

          Use MathJax to format equations. MathJax reference.


          To learn more, see our tips on writing great answers.




          draft saved


          draft discarded














          StackExchange.ready(
          function ()
          StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fcodereview.stackexchange.com%2fquestions%2f194859%2fa-rather-accurate-vba-stopwatch%23new-answer', 'question_page');

          );

          Post as a guest















          Required, but never shown





















































          Required, but never shown














          Required, but never shown












          Required, but never shown







          Required, but never shown

































          Required, but never shown














          Required, but never shown












          Required, but never shown







          Required, but never shown







          Popular posts from this blog

          名間水力發電廠 目录 沿革 設施 鄰近設施 註釋 外部連結 导航菜单23°50′10″N 120°42′41″E / 23.83611°N 120.71139°E / 23.83611; 120.7113923°50′10″N 120°42′41″E / 23.83611°N 120.71139°E / 23.83611; 120.71139計畫概要原始内容臺灣第一座BOT 模式開發的水力發電廠-名間水力電廠名間水力發電廠 水利署首件BOT案原始内容《小檔案》名間電廠 首座BOT水力發電廠原始内容名間電廠BOT - 經濟部水利署中區水資源局

          Prove that NP is closed under karp reduction?Space(n) not closed under Karp reductions - what about NTime(n)?Class P is closed under rotation?Prove or disprove that $NL$ is closed under polynomial many-one reductions$mathbfNC_2$ is closed under log-space reductionOn Karp reductionwhen can I know if a class (complexity) is closed under reduction (cook/karp)Check if class $PSPACE$ is closed under polyonomially space reductionIs NPSPACE also closed under polynomial-time reduction and under log-space reduction?Prove PSPACE is closed under complement?Prove PSPACE is closed under union?

          Is my guitar’s action too high? Announcing the arrival of Valued Associate #679: Cesar Manara Planned maintenance scheduled April 23, 2019 at 23:30 UTC (7:30pm US/Eastern)Strings too stiff on a recently purchased acoustic guitar | Cort AD880CEIs the action of my guitar really high?Μy little finger is too weak to play guitarWith guitar, how long should I give my fingers to strengthen / callous?When playing a fret the guitar sounds mutedPlaying (Barre) chords up the guitar neckI think my guitar strings are wound too tight and I can't play barre chordsF barre chord on an SG guitarHow to find to the right strings of a barre chord by feel?High action on higher fret on my steel acoustic guitar