wait less than one second

spurs

Active Member
it is my understanding that using application. Wait will only work for durations of 1 second or more

I need a way of waiting either 3 milliseconds or more up to about 50 milliseconds for one function I need to perform and up to as much as 500 millisecons (i.e. half a second) for another function.

How can I achieve these shorter wait durations in a way that is both 32 and 64 bit compatable>

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
That website shows the following example

#If VBA7 And Win64 Then
' 64 bit Excel
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongLong)
#Elsee
' 32 bit Excel
Public Declare Sub Sleep Lib "kernel32" ( ByVal dwMilliseconds As Long)
#End If

Sub Test()
Sleep NumberOfSeconds * 1000
End Sub

Questions:
1) is the syntax correct to isolate 32 or 64 bit operation
2) So far I only tried Sleep on a 32 bit system and found on my computer that any resolution below about 35 milliseconds does not work

you could probably do .Calculate in your code for 30 milliseconds !!

How would you control it to exactly 30 milliseconds?

you won't !!
I'd be guessing you won't with whatever you try !

@spurs

How about using a high-resulution timer .

Here is an example that should be more accurate than the Sleep API :

Code:
``````Option Explicit

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  Win64 Then
Declare PtrSafe Function GetTickCount Lib "kernel32" Alias "GetTickCount64" () As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL]
Declare PtrSafe Function GetTickCount Lib "kernel32" () As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL]
Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
Declare Function GetTickCount Lib "kernel32" () As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

Sub Delay(Byval interval As Currency) [B][COLOR=#008000]'interval in milisecs[/COLOR][/B]

Dim curFrq As Currency
Dim curStartPerformCounter As Currency
Dim curEndPerformanceCounter As Currency

If QueryPerformanceFrequency(curFrq) Then
curFrq = curFrq / 1000
If QueryPerformanceCounter(curStartPerformCounter) Then
Do
Call QueryPerformanceCounter(curEndPerformanceCounter)
Loop Until (curEndPerformanceCounter - curStartPerformCounter) / curFrq >= interval '_
End If
End If

End Sub``````

And here is what I got trying to wait 2 secs :
Code:
``````Sub TEST()

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
Dim lTickCount As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL]
Dim lTickCount As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
Dim i As Long, j As Long

Const SECONDS_WAIT = 2 [B][COLOR=#008000]'Secs[/COLOR][/B]

[B][COLOR=#008000]'Sleep API[/COLOR][/B]
[COLOR=#008000][B]'=======[/B][/COLOR]
lTickCount = GetTickCount
For j = 1 To SECONDS_WAIT
For i = 1 To 1000
Sleep 1 [B][COLOR=#008000]'wait 1 ms[/COLOR][/B]
Next i
Next j
Debug.Print "Sought Wait: " & SECONDS_WAIT * 1000 & " ms" & " (Sleep API)"; " ..... Actual Wait : "; GetTickCount - lTickCount & " ms"

Debug.Print "***********************************************"

[B][COLOR=#008000]'Delay Sub[/COLOR][/B]
[COLOR=#008000][B]'========[/B][/COLOR]
lTickCount = GetTickCount
For j = 1 To SECONDS_WAIT
For i = 1 To 1000
Delay 1 [B][COLOR=#008000]'wait 1 ms[/COLOR][/B]
Next i
Next j
Debug.Print "Sought Wait: " & SECONDS_WAIT * 1000 & " ms" & " (Delay Sub )"; "...... Actual Wait : "; GetTickCount - lTickCount & " ms"

End Sub``````

OUTPUT:

Code:
``````Sought Wait: 2000 ms (Sleep API) ..... Actual Wait : 4000 ms
***********************************************
Sought Wait: 2000 ms (Delay Sub )...... Actual Wait : 2016 ms``````

Last edited:

I tested it to as fast as 1 ms on my system and over 100 scans, the combined average was 1.1 ms
some individual scans showed 0 while others showed 15 or 16 ms but the average was very near target

Doing the same test over 10 scans averaged 1.6 ms

Over 20 scans averaged 1.55 ms

Over 50 scans 1.24 ms

Here was my code to determine this

Sub TEST()

#If VBA7 Then
Dim Tickcount1(100), Tickcount2(100) As LongPtr
#Else
Dim Tickcount1(100), Tickcount2(100) As Long
#End If
Dim i, scans As Long
Dim a As Variant

scans = 50

For i = 1 To scans
Tickcount1(i) = GetTickCount ' GetTickCouont is the number of ms since windows started - this resets every 49 days
Delay 1 'wait time in ms
Tickcount2(i) = GetTickCount
Next i
For i = 1 To scans
Debug.Print Tickcount2(i) - Tickcount1(i) ' use control G to show results in the window below
Next i
a = (Tickcount2(scans) - Tickcount1(1)) / scans
Debug.Print a

End Sub

Last edited:

Replies
10
Views
384
Replies
0
Views
528
Replies
0
Views
265
Replies
1
Views
364
Replies
0
Views
662

1,202,991
Messages
6,052,965
Members
444,622
Latest member
Kriszilla

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.

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

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