Search code examples
excelexcel-2007waitvba

Application.Wait Breaks my Code


Original

I have the following code that is coloring a cell to demonstrate the use of milisecond wait time. However, when i = 500 the code breaks. The error I get is Code Execution has been Interrupted and from 500 to 1000 I have to keep clicking continue. I've tried to wrap my code in an Application.DisplayAlerts = False and True but it still gets interrupted and won't finish. I estimate this code will take approximately 6 minutes more or less as i approaches 1000. I'm at a loss as to what could cause this. I've gone through every setting I can think of and it won't continue past 500 without breaking. ms was calculated from 1/(1000*24*60*60).

Excel 2007

Sub Kaleidoscope()
Dim r, g, b, i As Integer, ms As Double

ms = 0.0000000115741
For i = 1 To 1000
    r = WorksheetFunction.RandBetween(1, 255)
    g = WorksheetFunction.RandBetween(1, 255)
    b = WorksheetFunction.RandBetween(1, 255)
    Range("A1").Interior.Color = RGB(r, g, b)
    Application.Wait (Now + (ms * i))
Next i

End Sub

Thank you in advance!

Update

The link provided by @MarcoMarc (stackoverflow.com/a/5823507/5175942) solved the initial breaking problem of my question. However, it still does not appear to be incrementing correctly. It goes as if it isn't waiting until i = 500 then appears to be stalling 1 second every time. Is this the limit you were speaking of and ultimately it is not possible to wait for 1 ms? No change in the original code was needed to prevent the breaking.

Final Thoughts

@JohnMuggins gives a great tweak to my original code and provides additional tools to see the calculations behinds the scenes. Ultimatley though, he also had to call winAPI like @MacroMarc in order to pause the code for less than 1 second. Through research on additional websites and through Stack Overflow, it appears not possible to pause the program for less than 1 second using VBA alone. It either runs at normal speed or when it gets to 500 ms it rounds up to 1 second and delays the code for 1 second instead of 500 ms. My final code for demonstration is below with @JohnMuggins tweaks.

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

Sub Kaleidascope()
Dim StartTime As Double
Dim EndTime As Double
Dim ms As Double
Dim i, r, g, b As Integer
Dim count As Long

StartTime = Timer

For i = 1 To 500
    ms = i
    r = WorksheetFunction.RandBetween(1, 255)
    g = WorksheetFunction.RandBetween(1, 255)
    b = WorksheetFunction.RandBetween(1, 255)
    Range("A1").Interior.Color = RGB(r, g, b)
    Sleep ms
    Range("B1").Value = "Time: " & Format(Timer - StartTime, "####.###")
    Range("C1").Value = "ms =  " & Format(ms, "####.####")
    Range("D1").Value = i & " of 500"
Next i

EndTime = Timer - StartTime
Debug.Print Format(EndTime, "####.##")
End Sub

Solution

  • You could use the Sleep function from winAPI.

    At the top of the module:

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

    Then in your code:

    Sleep i ' where i is now in milliseconds

    Note that Sleep delays all VBA code.