How to give a time delay of less than one second in excel 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

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 7

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 8

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 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