Time elapsed between two macros in milliseconds

alkarkar

Board Regular
Joined
Sep 18, 2005
Messages
125
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
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

Zack Barresse

MrExcel MVP
Joined
Dec 9, 2003
Messages
10,881
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
  3. Web
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
 
L

Legacy 98055

Guest
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:progid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD><font size="2" face=Courier New>  <font color="#0000A0">Option</font> <font color="#0000A0">Explicit</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Declare</font> <font color="#0000A0">Function</font> QueryPerformanceCounter <font color="#0000A0">Lib</font> "kernel32" _
  (lpPerformanceCount <font color="#0000A0">As</font> LARGE_INTEGER) <font color="#0000A0">As</font> <font color="#0000A0">Long</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Declare</font> <font color="#0000A0">Function</font> QueryPerformanceFrequency <font color="#0000A0">Lib</font> "kernel32" _
  (lpFrequency <font color="#0000A0">As</font> LARGE_INTEGER) <font color="#0000A0">As</font> <font color="#0000A0">Long</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Declare</font> <font color="#0000A0">Sub</font> CopyMemory <font color="#0000A0">Lib</font> "kernel32.dll" <font color="#0000A0">Alias</font> "RtlMoveMemory" _
  (Destination <font color="#0000A0">As</font> Any, Source <font color="#0000A0">As</font> Any, <font color="#0000A0">ByVal</font> Length <font color="#0000A0">As</font> Long)

  <font color="#0000A0">Private</font> <font color="#0000A0">Type</font> LARGE_INTEGER
       LowPart <font color="#0000A0">As</font> <font color="#0000A0">Long</font>
       HighPart <font color="#0000A0">As</font> <font color="#0000A0">Long</font>
  <font color="#0000A0">End</font> <font color="#0000A0">Type</font>

  <font color="#0000A0">Sub</font> QueryPerformanceCounterExample()
       <font color="#0000A0">Dim</font> c <font color="#0000A0">As</font> Collection, Tics <font color="#0000A0">As</font> <font color="#0000A0">Double</font>

       PerformanceCounter "START"
      <font color="#008000"> '##########################################################</font>
      <font color="#008000"> 'start timing your code here</font>



      <font color="#008000"> 'your code or call to subs/functions here</font>
       <font color="#0000A0">Dim</font> r <font color="#0000A0">As</font> Range
       <font color="#0000A0">For</font> <font color="#0000A0">Each</font> r <font color="#0000A0">In</font> Range("A1:A1000")
           r = 1
       <font color="#0000A0">Next</font>


      <font color="#008000"> 'stop timing your code here</font>
      <font color="#008000"> '##########################################################</font>
       PerformanceCounter "STOP", Tics



       <font color="#0000A0">Set</font> 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")

       <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> PerformanceCounter(Action <font color="#0000A0">As</font> String, <font color="#0000A0">Optional</font> <font color="#0000A0">ByRef</font> Tics <font color="#0000A0">As</font> Double)
       <font color="#0000A0">Static</font> liStart <font color="#0000A0">As</font> LARGE_INTEGER
       <font color="#0000A0">Dim</font> cuStart <font color="#0000A0">As</font> Currency, cuStop <font color="#0000A0">As</font> Currency, T <font color="#0000A0">As</font> Long, liStop <font color="#0000A0">As</font> LARGE_INTEGER

       <font color="#0000A0">If</font> Action = "START" <font color="#0000A0">Then</font>
           QueryPerformanceCounter liStart
           <font color="#0000A0">Exit</font> <font color="#0000A0">Sub</font>
       <font color="#0000A0">End</font> <font color="#0000A0">If</font>

       QueryPerformanceCounter liStop
       cuStart = LargeIntToCurrency(liStart)
       cuStop = LargeIntToCurrency(liStop)
       Tics = cuStop - cuStart
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Function</font> LargeIntToCurrency(liInput <font color="#0000A0">As</font> LARGE_INTEGER) <font color="#0000A0">As</font> <font color="#0000A0">Currency</font>
      <font color="#008000"> 'copy 8 bytes from the large integer to an ampty currency</font>
       CopyMemory LargeIntToCurrency, liInput, LenB(liInput)
      <font color="#008000"> 'adjust it</font>
       LargeIntToCurrency = LargeIntToCurrency * 10000
  <font color="#0000A0">End</font> <font color="#0000A0">Function</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Function</font> TimeBreakdown(Tics <font color="#0000A0">As</font> Double) <font color="#0000A0">As</font> Collection
       <font color="#0000A0">Dim</font> Hours <font color="#0000A0">As</font> Integer, Minutes <font color="#0000A0">As</font> Integer, Seconds <font color="#0000A0">As</font> Integer, Fraction <font color="#0000A0">As</font> <font color="#0000A0">Double</font>
       <font color="#0000A0">Dim</font> cuFrequency <font color="#0000A0">As</font> Currency, liFrequency <font color="#0000A0">As</font> LARGE_INTEGER
       <font color="#0000A0">Dim</font> c <font color="#0000A0">As</font> <font color="#0000A0">New</font> Collection

       <font color="#0000A0">If</font> QueryPerformanceFrequency(liFrequency) = 0 <font color="#0000A0">Then</font>
           MsgBox "Your hardware doesn't support a high-resolution performance counter!", _
             vbInformation
           <font color="#0000A0">Exit</font> <font color="#0000A0">Function</font>
       <font color="#0000A0">End</font> <font color="#0000A0">If</font>

       cuFrequency = LargeIntToCurrency(liFrequency)
       Fraction = Tics / cuFrequency

       <font color="#0000A0">If</font> Fraction >= 3600 <font color="#0000A0">Then</font>
           Hours = Int(Fraction / 3600)
           Fraction = Fraction - (Hours * 3600)
       <font color="#0000A0">End</font> <font color="#0000A0">If</font>

       <font color="#0000A0">If</font> Fraction >= 60 <font color="#0000A0">Then</font>
           Minutes = Int(Fraction / 60)
           Fraction = Fraction - (Minutes * 60)
       <font color="#0000A0">End</font> <font color="#0000A0">If</font>

       <font color="#0000A0">If</font> Fraction >= 1 <font color="#0000A0">Then</font>
           Seconds = Int(Fraction / 1)
           Fraction = Fraction - (Seconds * 1)
       <font color="#0000A0">End</font> <font color="#0000A0">If</font>

       c.Add Hours, "Hours"
       c.Add Minutes, "Minutes"
       c.Add Seconds, "Seconds"
       c.Add Fraction, "Fraction"
       <font color="#0000A0">Set</font> TimeBreakdown = c
       <font color="#0000A0">Set</font> c = <font color="#0000A0">Nothing</font>

  <font color="#0000A0">End</font> <font color="#0000A0">Function</font>
</FONT></td></tr></table><button onclick='document.all("9172006182638852").value=document.all("9172006182638852").value.replace(/<br \/>\s\s/g,"");document.all("9172006182638852").value=document.all("9172006182638852").value.replace(/<br \/>/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
 

Forum statistics

Threads
1,136,953
Messages
5,678,749
Members
419,782
Latest member
gc75150

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top