VBA delay-time granularity and its real value [duplicate] - vba

Question

i want to repeat an event after a certain duration that is less than 1 second. I tried using the following code
Application.wait Now + TimeValue ("00:00:01")
But here the minimum delay time is one second. How to give a delay of say half a seond?

Answer 1

You can use an API call and Sleep:
Put this at the top of your module:
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Then you can call it in a procedure like this:
Sub test()
Dim i As Long
For i = 1 To 10
Debug.Print Now()
Sleep 500 'wait 0.5 seconds
Next i
End Sub

Answer 2

I found this on another site not sure if it works or not.
Application.Wait Now + 1/(24*60*60.0*2)
the numerical value 1 = 1 day
1/24 is one hour
1/(24*60) is one minute
so 1/(24*60*60*2) is 1/2 second
You need to use a decimal point somewhere to force a floating point number
Source
Not sure if this will work worth a shot for milliseconds
Application.Wait (Now + 0.000001)

Answer 3

call waitfor(.005)
Sub WaitFor(NumOfSeconds As Single)
Dim SngSec as Single
SngSec=Timer + NumOfSeconds
Do while timer < sngsec
DoEvents
Loop
End sub
source
Timing Delays in VBA

Answer 4

I have try this and it works for me:
Private Sub DelayMs(ms As Long)
Debug.Print TimeValue(Now)
Application.Wait (Now + (ms * 0.00000001))
Debug.Print TimeValue(Now)
End Sub
Private Sub test()
Call DelayMs (2000) 'test code with delay of 2 seconds, see debug window
End Sub

Answer 5

Everyone tries Application.Wait, but that's not really reliable. If you ask it to wait for less than a second, you'll get anything between 0 and 1, but closer to 10 seconds. Here's a demonstration using a wait of 0.5 seconds:
Sub TestWait()
Dim i As Long
For i = 1 To 5
Dim t As Double
t = Timer
Application.Wait Now + TimeValue("0:00:00") / 2
Debug.Print Timer - t
Next
End Sub
Here's the output, an average of 0.0015625 seconds:
0
0
0
0.0078125
0
Admittedly, Timer may not be the ideal way to measure these events, but you get the idea.
The Timer approach is better:
Sub TestTimer()
Dim i As Long
For i = 1 To 5
Dim t As Double
t = Timer
Do Until Timer - t >= 0.5
DoEvents
Loop
Debug.Print Timer - t
Next
End Sub
And the results average is very close to 0.5 seconds:
0.5
0.5
0.5
0.5
0.5

Answer 6

Obviously an old post, but this seems to be working for me....
Application.Wait (Now + TimeValue("0:00:01") / 1000)
Divide by whatever you need. A tenth, a hundredth, etc. all seem to work. By removing the "divide by" portion, the macro does take longer to run, so therefore, with no errors present, I have to believe it works.

Answer 7

No answer helped me, so I build this.
' function Timestamp return current time in milliseconds.
' compatible with JSON or JavaScript Date objects.
Public Function Timestamp () As Currency
timestamp = (Round(Now(), 0) * 24 * 60 * 60 + Timer()) * 1000
End Function
' function Sleep let system execute other programs while the milliseconds are not elapsed.
Public Function Sleep(milliseconds As Currency)
If milliseconds < 0 Then Exit Function
Dim start As Currency
start = Timestamp ()
While (Timestamp () < milliseconds + start)
DoEvents
Wend
End Function
Note : In Excel 2007, Now() send Double with decimals to seconds, so i use Timer() to get milliseconds.
Note : Application.Wait() accept seconds and no under (i.e. Application.Wait(Now()) ↔ Application.Wait(Now()+100*millisecond)))
Note : Application.Wait() doesn't let system execute other program but hardly reduce performance. Prefer usage of DoEvents.

Answer 8

Otherwise you can create your own function then call it. It is important to use Double
Function sov(sekunder As Double) As Double
starting_time = Timer
Do
DoEvents
Loop Until (Timer - starting_time) >= sekunder
End Function

Answer 9

To pause for 0.8 of a second:
Sub main()
startTime = Timer
Do
Loop Until Timer - startTime >= 0.8
End Sub

Answer 10

Public Function CheckWholeNumber(Number As Double) As Boolean
If Number - Fix(Number) = 0 Then
CheckWholeNumber = True
End If
End Function
Public Sub TimeDelay(Days As Double, Hours As Double, Minutes As Double, Seconds As Double)
If CheckWholeNumber(Days) = False Then
Hours = Hours + (Days - Fix(Days)) * 24
Days = Fix(Days)
End If
If CheckWholeNumber(Hours) = False Then
Minutes = Minutes + (Hours - Fix(Hours)) * 60
Hours = Fix(Hours)
End If
If CheckWholeNumber(Minutes) = False Then
Seconds = Seconds + (Minutes - Fix(Minutes)) * 60
Minutes = Fix(Minutes)
End If
If Seconds >= 60 Then
Seconds = Seconds - 60
Minutes = Minutes + 1
End If
If Minutes >= 60 Then
Minutes = Minutes - 60
Hours = Hours + 1
End If
If Hours >= 24 Then
Hours = Hours - 24
Days = Days + 1
End If
Application.Wait _
( _
Now + _
TimeSerial(Hours + Days * 24, Minutes, 0) + _
Seconds * TimeSerial(0, 0, 1) _
)
End Sub
example:
call TimeDelay(1.9,23.9,59.9,59.9999999)
hopy you enjoy.
edit:
here's one without any additional functions, for people who like it being faster
Public Sub WaitTime(Days As Double, Hours As Double, Minutes As Double, Seconds As Double)
If Days - Fix(Days) > 0 Then
Hours = Hours + (Days - Fix(Days)) * 24
Days = Fix(Days)
End If
If Hours - Fix(Hours) > 0 Then
Minutes = Minutes + (Hours - Fix(Hours)) * 60
Hours = Fix(Hours)
End If
If Minutes - Fix(Minutes) > 0 Then
Seconds = Seconds + (Minutes - Fix(Minutes)) * 60
Minutes = Fix(Minutes)
End If
If Seconds >= 60 Then
Seconds = Seconds - 60
Minutes = Minutes + 1
End If
If Minutes >= 60 Then
Minutes = Minutes - 60
Hours = Hours + 1
End If
If Hours >= 24 Then
Hours = Hours - 24
Days = Days + 1
End If
Application.Wait _
( _
Now + _
TimeSerial(Hours + Days * 24, Minutes, 0) + _
Seconds * TimeSerial(0, 0, 1) _
)
End Sub