Time elapsed between two macros in milliseconds

alkarkar · Sep 17, 2006

I run MACRO1 and after 1-2 sec MACRO2.
I want to record in cell A1 the time elapsed between the begging of these two macros in milliseconds. I'm not intrested for actual time but only for the difference with millisec accuracy.
If the starting time of MACRO1 is stored in a cell, this would be better because i could run MACRO2 for second time in a row and now get the time difference from MACRO1 and the second execution of MACRO2 (this would be my case most of the time)(run MACRO2 for 3,4,5... times in a row and get the time differences - MACRO1 will always be the starting time).
I suppose i will use the "GetTickCount" fuction but my VBA knowledge
is very poor and dont know how to use it.
Thanks, Alex

Zack Barresse · Sep 17, 2006

Hi there,

I would then just suggest that at the beginning of Macro1, you set Range("A1)".Value = Timer, then at the end of Macro2, you can set Range("A2").Value = Timer, then in A3 put =A2-A1. Format accordingly. (Format for milliseconds would be something like hh:mm:ss.s.

HTH

Legacy 98055 · Sep 17, 2006

I think the timer will only give you 100ths of a second. If you need more accuracy than this, use several API functions. Here is a ready made example. All you have to do is call your sub from the noted position in the procedure.

QueryPerformanceCounter.zip

<table width="100%" border="1" bgcolor="White" style="filter

rogid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD> Option Explicit

 Private Declare Function QueryPerformanceCounter Lib "kernel32" _
 (lpPerformanceCount As LARGE_INTEGER) As Long

 Private Declare Function QueryPerformanceFrequency Lib "kernel32" _
 (lpFrequency As LARGE_INTEGER) As Long

 Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
 (Destination As Any, Source As Any, ByVal Length As Long)

 Private Type LARGE_INTEGER
 LowPart As Long
 HighPart As Long
 End Type

 Sub QueryPerformanceCounterExample()
 Dim c As Collection, Tics As Double

 PerformanceCounter "START"
 '##########################################################
 'start timing your code here

 'your code or call to subs/functions here
 Dim r As Range
 For Each r In Range("A1:A1000")
 r = 1
 Next

 'stop timing your code here
 '##########################################################
 PerformanceCounter "STOP", Tics

 Set c = TimeBreakdown(Tics)

 Debug.Print "Precision = Hundedths of a second" & vbCrLf & _
 Format(c.Item("Hours"), "00:") & _
 Format(c.Item("Minutes"), "00:") & _
 Format(c.Item("Seconds"), "00") & _
 Format(c.Item("Fraction"), ".00")

 Debug.Print "Precision = milliseconds or Thousandths of a second" & vbCrLf & _
 Format(c.Item("Hours"), "00:") & _
 Format(c.Item("Minutes"), "00:") & _
 Format(c.Item("Seconds"), "00") & _
 Format(c.Item("Fraction"), ".000")

 Debug.Print "Precision = Billionths of a second" & vbCrLf & _
 Format(c.Item("Hours"), "00:") & _
 Format(c.Item("Minutes"), "00:") & _
 Format(c.Item("Seconds"), "00") & _
 Format(c.Item("Fraction"), ".000000000")

 End Sub

 Private Sub PerformanceCounter(Action As String, Optional ByRef Tics As Double)
 Static liStart As LARGE_INTEGER
 Dim cuStart As Currency, cuStop As Currency, T As Long, liStop As LARGE_INTEGER

 If Action = "START" Then
 QueryPerformanceCounter liStart
 Exit Sub
 End If

 QueryPerformanceCounter liStop
 cuStart = LargeIntToCurrency(liStart)
 cuStop = LargeIntToCurrency(liStop)
 Tics = cuStop - cuStart
 End Sub

 Private Function LargeIntToCurrency(liInput As LARGE_INTEGER) As Currency
 'copy 8 bytes from the large integer to an ampty currency
 CopyMemory LargeIntToCurrency, liInput, LenB(liInput)
 'adjust it
 LargeIntToCurrency = LargeIntToCurrency * 10000
 End Function

 Private Function TimeBreakdown(Tics As Double) As Collection
 Dim Hours As Integer, Minutes As Integer, Seconds As Integer, Fraction As Double
 Dim cuFrequency As Currency, liFrequency As LARGE_INTEGER
 Dim c As New Collection

 If QueryPerformanceFrequency(liFrequency) = 0 Then
 MsgBox "Your hardware doesn't support a high-resolution performance counter!", _
 vbInformation
 Exit Function
 End If

 cuFrequency = LargeIntToCurrency(liFrequency)
 Fraction = Tics / cuFrequency

 If Fraction >= 3600 Then
 Hours = Int(Fraction / 3600)
 Fraction = Fraction - (Hours * 3600)
 End If

 If Fraction >= 60 Then
 Minutes = Int(Fraction / 60)
 Fraction = Fraction - (Minutes * 60)
 End If

 If Fraction >= 1 Then
 Seconds = Int(Fraction / 1)
 Fraction = Fraction - (Seconds * 1)
 End If

 c.Add Hours, "Hours"
 c.Add Minutes, "Minutes"
 c.Add Seconds, "Seconds"
 c.Add Fraction, "Fraction"
 Set TimeBreakdown = c
 Set c = Nothing

 End Function
</td></tr></table><button onclick='document.all("9172006182638852").value=document.all("9172006182638852").value.replace(/ \s\s/g,"");document.all("9172006182638852").value=document.all("9172006182638852").value.replace(/ /g,"");window.clipboardData.setData("Text",document.all("9172006182638852").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="9172006182638852" wrap="virtual">
Option Explicit

Private Declare Function QueryPerformanceCounter Lib "kernel32" _
(lpPerformanceCount As LARGE_INTEGER) As Long

Private Declare Function QueryPerformanceFrequency Lib "kernel32" _
(lpFrequency As LARGE_INTEGER) As Long

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)

Private Type LARGE_INTEGER
LowPart As Long
HighPart As Long
End Type

Sub QueryPerformanceCounterExample()
Dim c As Collection, Tics As Double

PerformanceCounter "START"
'##########################################################
'start timing your code here

'your code or call to subs/functions here
Dim r As Range
For Each r In Range("A1:A1000")
r = 1
Next

'stop timing your code here
'##########################################################
PerformanceCounter "STOP", Tics

Set c = TimeBreakdown(Tics)

Debug.Print "Precision = Hundedths of a second" & vbCrLf & _
Format(c.Item("Hours"), "00:") & _
Format(c.Item("Minutes"), "00:") & _
Format(c.Item("Seconds"), "00") & _
Format(c.Item("Fraction"), ".00")

Debug.Print "Precision = milliseconds or Thousandths of a second" & vbCrLf & _
Format(c.Item("Hours"), "00:") & _
Format(c.Item("Minutes"), "00:") & _
Format(c.Item("Seconds"), "00") & _
Format(c.Item("Fraction"), ".000")

Debug.Print "Precision = Billionths of a second" & vbCrLf & _
Format(c.Item("Hours"), "00:") & _
Format(c.Item("Minutes"), "00:") & _
Format(c.Item("Seconds"), "00") & _
Format(c.Item("Fraction"), ".000000000")

End Sub

Private Sub PerformanceCounter(Action As String, Optional ByRef Tics As Double)
Static liStart As LARGE_INTEGER
Dim cuStart As Currency, cuStop As Currency, T As Long, liStop As LARGE_INTEGER

If Action = "START" Then
QueryPerformanceCounter liStart
Exit Sub
End If

QueryPerformanceCounter liStop
cuStart = LargeIntToCurrency(liStart)
cuStop = LargeIntToCurrency(liStop)
Tics = cuStop - cuStart
End Sub

Private Function LargeIntToCurrency(liInput As LARGE_INTEGER) As Currency
'copy 8 bytes from the large integer to an ampty currency
CopyMemory LargeIntToCurrency, liInput, LenB(liInput)
'adjust it
LargeIntToCurrency = LargeIntToCurrency * 10000
End Function

Private Function TimeBreakdown(Tics As Double) As Collection
Dim Hours As Integer, Minutes As Integer, Seconds As Integer, Fraction As Double
Dim cuFrequency As Currency, liFrequency As LARGE_INTEGER
Dim c As New Collection

If QueryPerformanceFrequency(liFrequency) = 0 Then
MsgBox "Your hardware doesn't support a high-resolution performance counter!", _
vbInformation
Exit Function
End If

cuFrequency = LargeIntToCurrency(liFrequency)
Fraction = Tics / cuFrequency

If Fraction >= 3600 Then
Hours = Int(Fraction / 3600)
Fraction = Fraction - (Hours * 3600)
End If

If Fraction >= 60 Then
Minutes = Int(Fraction / 60)
Fraction = Fraction - (Minutes * 60)
End If

If Fraction >= 1 Then
Seconds = Int(Fraction / 1)
Fraction = Fraction - (Seconds * 1)
End If

c.Add Hours, "Hours"
c.Add Minutes, "Minutes"
c.Add Seconds, "Seconds"
c.Add Fraction, "Fraction"
Set TimeBreakdown = c
Set c = Nothing

End Function</textarea>

The example wrote the following to the debug window on my old system:

Precision = Hundedths of a second
00:00:00.10
Precision = milliseconds or Thousandths of a second
00:00:00.096
Precision = Billionths of a second
00:00:00.096421193

QueryPerformanceCounter.zip

alkarkar · Sep 18, 2006

Thanks, i'll test them later in the day.

Time elapsed between two macros in milliseconds

alkarkar

Board Regular

Excel Facts

Zack Barresse

MrExcel MVP

Legacy 98055

Guest

alkarkar

Board Regular

Similar threads

Forum statistics

Share this page

Time elapsed between two macros in milliseconds

alkarkar

Board Regular

Excel Facts

Zack Barresse

MrExcel MVP

Legacy 98055

Guest

alkarkar

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock