CODEWITHSUNDEEP
excelvba
Rito
Rito

Reputation: 551

How to give a time delay of less than one second in excel vba?

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?

Upvotes: 45

Views: 224928

Answers (13)

user 88 91
user 88 91

Reputation: 65

I wrote these sleep "functions" to avoid using the windows API which is blocked in many windows defender corporation settings.

Will not work in millisecond increments on machintosh according to the documentation

Short answer does basically the same as long answer but won't take midnight changes or sleep for days (i.e sleep bigger than 86 400 000) into account

Short answer:

Sub shortsleep(ms As Double)
    Dim start: start = timer: ms = ms / 1000
    If ms < 0.01 Then: ms = 0.01
    While timer < start + ms: DoEvents: Wend
End Sub

Long answer:

'waits a close approximation of "argument milliseconds", un-comment debug.prints below to time it
Sub Sleep(ms As Double)
    Dim start As Single
    Dim sDate As Date
    Dim i As Double
    
    ms = ms / 1000
    
    If ms < 0.01 Then: ms = 0.01
    
    start = Timer
    sDate = Date
    
    i = 0             ' 86400 = 24 * 60 * 60
    While start + ms - (86400 * i) > 86400
        i = i + 1
    Wend
    
    ms = ms - (86400 * i)
    'Debug.Print "Starting sleep for " & ms * 1000 & " milliseconds"
    While Timer < start + ms Or DateDiff("d", sDate, Date) < i
        DoEvents
    Wend
    'Dim r As Double: r = Round((1# * Timer - start) * 1000): Debug.Print "sleep ran for " & r & " ms."
End Sub

Upvotes: 0

Gove
Gove

Reputation: 1794

Just updating for 64-bit Excel for Windows. Put the following at the top of your module

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

you can test with the following code

Sub test()
  Dim i As Long

  For i = 1 To 10
    Debug.Print Now()
    Sleep 500    'wait 0.5 seconds
  Next i
End Sub

Upvotes: 0

Klaus
Klaus

Reputation: 1

If you want to start an event some time interval from now, and in the meantime want your code to continue, this Wait stuff won't work. Here you have to use the OnTime method in combination with the TimeValue function. So if you want to start the procedure "DoSomething" after one tenth of a second, use this code:

Application.OnTime Now + TimeValue("00:00:01") / 10, "DoSomething"

Upvotes: 0

Jon Peltier
Jon Peltier

Reputation: 6063

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

Upvotes: 6

user12015430
user12015430

Reputation: 21

To pause for 0.8 of a second:

Sub main()
    startTime = Timer
    Do
    Loop Until Timer - startTime >= 0.8
End Sub

Upvotes: 2

VilhelmP
VilhelmP

Reputation: 21

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

Upvotes: 2

karkael
karkael

Reputation: 473

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.

Upvotes: 2

RollTideMike
RollTideMike

Reputation: 39

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.

Upvotes: 2

graham nelson
graham nelson

Reputation: 235

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)

Upvotes: 21

matan justme
matan justme

Reputation: 399

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

Upvotes: 0

user4232305
user4232305

Reputation: 179

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

Upvotes: 16

Nam
Nam

Reputation: 79

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

Upvotes: 7

Doug Glancy
Doug Glancy

Reputation: 27478

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

Upvotes: 35

Related Questions