1 sec delay lasts almost 2 sec

Question

I am writing a code to copy data from one spreadsheet to an other one in every second. I have tried Application.Wait and Sleep but they blocked both spreadsheets so I decided to use a do until loop. It works but 1 sec lasts almost 2 sec and I don't know why. So I left only the loop in the code but the test gave the same result (it took ca 95 sec). Any suggestion? Here is the code:

    Sub Test()

    Dim Delay As Date

    cell = 1

    For i = 1 to 60

     Workbooks("Data").Worksheets("Sheet1").Range("C" & cell).Value = cell

     cell = cell +1
     Delay = Now() + TimeValue("00:00:01")

     Do Until Now() >= Delay

      Do Events

     Loop

    Next i

    End Sub

Answer 1

That is only an approximate delay because you really have no idea of what else is going through the message queue and being processed by the DoEvents command (one word btw). An alternative would be to call the procedure from within itself with the Application.OnTime method.

Sub timed_routine()
    Application.Interactive = False
    ThisWorkbook.Worksheets("Sheet1").Cells(1, 1) = 1
    Application.Interactive = True
    'Debug.Print Timer
    Application.OnTime Now + TimeSerial(0, 0, 1), "timed_routine"
End Sub

With the Debug.Print Timer command uncommented and active, this routine was cycling in about 1.015 seconds.