Visual Basic for Applications/Delays Past Midnight

Summary

This VBA module delays for a specified number of seconds. It will work in any MS Office application that can run VBA. The following points are worth noting:

Most delay procedures have problems at midnight when the Timer function resets, so code that depends on the difference of two values that span that time will be in error, and will perhaps cause a failure. This procedure avoids such problems by also compensating for the number of lapsed days. As such it will be found useful in timing and clock applications, if not for measuring time, at least for deciding when the display is to be updated. For example; running a delay of twenty seconds from ten seconds to midnight (clock count 86390) to ten seconds after midnight (supposed clock count 86410) would reset at midnight, and would never reach the required end value. The problem is solved by adding one count of 86400 (the number of seconds in one day) to the stepped value for each time that a date transition is made.
The anticipated resolution of the procedure is about 10-16mS, consistent with that of the system timer. It is perhaps of interest to note that the GetTickCount API while able to accept millisecond parameters is still limited to the same 10-16mS resolution of the system timer.
The procedure parameter can take on integers and fractions of a second, provided comments about resolution are borne in mind.

The Code

Copy the following VBA code into a standard module in Excel, Word, or any other Office application that supports VBA.

Option Explicit

Sub testDelay()
    'tests delay procedure
    
    MsgBox DelaySecs(1.1)    'seconds

End Sub

Function DelaySecs(nSecs As Single) As Boolean
    'Delays for nSecs SECONDS.
    'Avoids midnight reset problem.
    'Typical resolution 10-16mS.
    
    Dim StartDate As Date
    Dim StartTime As Single
    Dim TimeNow As Single
    Dim Lapsed As Single
    
    'get launch date and current timer
    StartTime = Timer
    StartDate = Date
    
    'then loop until lapse of parameter time
    Do
        DoEvents 'allow form updates and breaks
        '86400 seconds per new day
        TimeNow = 86400 * (Date - StartDate) + Timer
        Lapsed = TimeNow - StartTime
    Loop Until Lapsed >= nSecs
    'MsgBox Lapsed
    
    DelaySecs = True
    
End Function

Summary

The Code

See Also