wait less than one second

[spurs]

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>

 

[Logit]

.

Untested here :

https://stackoverflow.com/questions...me-delay-of-less-than-one-second-in-excel-vba

http://www.cpearson.com/excel/WaitFunctions.aspx

 

[spurs]

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

 

[Michael M]

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

 

[spurs]

How would you control it to exactly 30 milliseconds?

 

[Michael M]

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

 

[Jaafar Tribak]

@spurs

How about using a high-resulution timer .

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

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 :

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:

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

 

[spurs]

Your Delay method works amazingly

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