How to get a DateDiff-Value in milliseconds in VBA (Excel)? - vba

Question

I need to calculate the difference between two timestamps in milliseconds.
Unfortunately, the DateDiff-function of VBA does not offer this precision.
Are there any workarounds?

Answer 1

You could use the method described here as follows:-
Create a new class module called StopWatch
Put the following code in the StopWatch class module:
Private mlngStart As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Public Sub StartTimer()
mlngStart = GetTickCount
End Sub
Public Function EndTimer() As Long
EndTimer = (GetTickCount - mlngStart)
End Function
You use the code as follows:
Dim sw as StopWatch
Set sw = New StopWatch
sw.StartTimer
' Do whatever you want to time here
Debug.Print "That took: " & sw.EndTimer & "milliseconds"
Other methods describe use of the VBA Timer function but this is only accurate to one hundredth of a second (centisecond).

Answer 2

If you just need time elapsed in Centiseconds then you don't need the TickCount API. You can just use the VBA.Timer Method which is present in all Office products.
Public Sub TestHarness()
Dim fTimeStart As Single
Dim fTimeEnd As Single
fTimeStart = Timer
SomeProcedure
fTimeEnd = Timer
Debug.Print Format$((fTimeEnd - fTimeStart) * 100!, "0.00 "" Centiseconds Elapsed""")
End Sub
Public Sub SomeProcedure()
Dim i As Long, r As Double
For i = 0& To 10000000
r = Rnd
Next
End Sub

Answer 3

GetTickCount and Performance Counter are required if you want to go for micro seconds..
For millisenconds you can just use some thing like this..
'at the bigining of the module
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Declare Sub GetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
'In the Function where you need find diff
Dim sSysTime As SYSTEMTIME
Dim iStartSec As Long, iCurrentSec As Long
GetLocalTime sSysTime
iStartSec = CLng(sSysTime.wSecond) * 1000 + sSysTime.wMilliseconds
'do your stuff spending few milliseconds
GetLocalTime sSysTime ' get the new time
iCurrentSec=CLng(sSysTime.wSecond) * 1000 + sSysTime.wMilliseconds
'Different between iStartSec and iCurrentSec will give you diff in MilliSecs

Answer 4

If Timer() precision is enough then you can just create timestamp by combining date and time with milliseconds:
Function Now2() As Date
Now2 = Date + CDate(Timer / 86400)
End Function
To calculate the difference between two timestamps in milliseconds you may subtract them:
Sub test()
Dim start As Date
Dim finish As Date
Dim i As Long
start = Now2
For i = 0 To 100000000
Next
finish = Now2
Debug.Print (finish - start) & " days"
Debug.Print (finish - start) * 86400 & " sec"
Debug.Print (finish - start) * 86400 * 1000 & " msec"
End Sub
Actual precision of that method is about 8 msec (BTW GetTickCount is even worse - 16 msec) for me.

Answer 5

You can also use =NOW() formula calcilated in cell:
Dim ws As Worksheet
Set ws = Sheet1
ws.Range("a1").formula = "=now()"
ws.Range("a1").numberFormat = "dd/mm/yyyy h:mm:ss.000"
Application.Wait Now() + TimeSerial(0, 0, 1)
ws.Range("a2").formula = "=now()"
ws.Range("a2").numberFormat = "dd/mm/yyyy h:mm:ss.000"
ws.Range("a3").formula = "=a2-a1"
ws.Range("a3").numberFormat = "h:mm:ss.000"
var diff as double
diff = ws.Range("a3")

Answer 6

Apologies to wake up this old post, but I got an answer:
Write a function for Millisecond like this:
Public Function TimeInMS() As String
TimeInMS = Strings.Format(Now, "HH:nn:ss") & "." & Strings.Right(Strings.Format(Timer, "#0.00"), 2)
End Function
Use this function in your sub:
Sub DisplayMS()
On Error Resume Next
Cancel = True
Cells(Rows.Count, 2).End(xlUp).Offset(1) = TimeInMS()
End Sub

Answer 7

Besides the Method described by AdamRalph (GetTickCount()), you can do this:
Using the QueryPerformanceCounter() and QueryPerformanceFrequency() API Functions
How do you test running time of VBA code?
or, for environments without access to the Win32 API (like VBScript), this:
http://ccrp.mvps.org/ (check the download section for the "High-Performance Timer" installable COM objects. They're free.)