How to run macro for 10 seconds and stop?

[Father Guido]

Hi,

I have a simple countdown spreadsheet, which uses the following macro
to start it

Sub Countdown()
Do Until Date = "09/30/2007 23:59:59"
Calculate
Loop
End Sub

This accomplishes what I need to display, but how can I end it
gracefully? Right now all I can do is press the ESC key which brings
up Microsoft Basic to tell me that the code has been interrupted and
wants to know if I want to debug, continue or end. Could someone
suggest a simple way to allow the macro to run for 10 seconds and
then stop without exiting? Appreciate any help given.

Thanks,

Norm

 

[Peter T]

This is not very accurate, just for ideas -

Sub test()
Dim nDelay As Long
Dim tmStop As Date, tmNextUpDate As Date

On Error GoTo errH
Application.EnableCancelKey = xlErrorHandler

nDelay = 10

tmStop = Now + TimeSerial(0, 0, nDelay)
nDelay = 10
tmNextUpDate = Now + TimeSerial(0, 0, 0.5)
Do While Now < tmStop
If Now > tmNextUpDate Then
tmNextUpDate = tmNextUpDate + TimeSerial(0, 0, 1)
nDelay = nDelay - 1
Application.StatusBar = nDelay
End If
Loop

done:
Application.StatusBar = False

MsgBox "done"
On Error GoTo 0
Application.EnableCancelKey = xlInterrupt

Exit Sub
errH:

If Err.Number = 18 And nDelay Then

' if you don't want user to escapte with Ctrl-Break simply - Resume

If MsgBox("Continue with timer ?", vbOKCancel) = vbOK Then
tmNextUpDate = Now + TimeSerial(0, 0, 0.5)
tmStop = Now + TimeSerial(0, 0, nDelay)
Resume
Else
Resume done
End If
End If
End Sub

Regards,
Peter T