Revised Time Count-Down

[Yogi]

I want to be able to press a macro button that initiates a count down from 25-0 seconds in cell B2. Is this possible?

 

[Richie(UK)]

Hi Yogi,

Is this what you want?
<pre>Sub CountDown()
Dim pausetime As Single
Dim start As Single
Dim finish As Single
Dim totaltime As Single

pausetime = 25 ' Set duration.
start = Timer ' Set start time.

Do While Timer < start + pausetime
DoEvents ' Yield to other processes.
Sheets(1).Range("B2").Value = _
Format(pausetime + (start - Timer), "##")
Loop

finish = Timer ' Set end time.
totaltime = finish - start
End

End Sub</pre>
HTH

 

[Yogi]

Richie,
It works great! Thanks!
Is there any way I could write the macro to display the "25" seconds before the button is pushed starting the countdown and then after the countdown is completed it goes back to displaying the "25" seconds until the button is pushed again?
Thanks again.

 

[Ivan F Moala]

On 2002-10-25 17:45, Yogi wrote:
Richie,
It works great! Thanks!
Is there any way I could write the macro to display the "25" seconds before the button is pushed starting the countdown and then after the countdown is completed it goes back to displaying the "25" seconds until the button is pushed again?
Thanks again.

Just change to the following:

<pre/>
Sub CountDown()
Dim pausetime As Single
Dim start As Single
Dim finish As Single
Dim totaltime As Single

pausetime = 25 ' Set duration.
start = Timer ' Set start time.
Sheets(1).Range("B2").Value = 25
Do While Timer < start + pausetime
DoEvents ' Yield to other processes.
Sheets(1).Range("B2").Value = _
Format(pausetime + (start - Timer), "##")
Loop

Sheets(1).Range("B2").Value = 25

End Sub
</pre>

Note: Whilst Do Events yields to other processes you will notice 2 things;
1) There is a flicker
2) Editing cells will stop the operating macro.

There are a number of ways to over come this;
1) Use an ActiveX control timer
2) Use an Ontile call
3) Use some API calls to the winmm dll

 

[zacemmel]

I would just use the timer control and set the interval to 1000:

Private Sub Workbook_Open()
Sheets("sheet1").IeTimer1.Interval = 1000
End Sub


Private Sub IeTimer1_Timer()
if cTime<= 0 then
ietimer.interval = 0
else
range("yourcell").value = cTick
end if
module1.ctick=module1.cTick - 1
End Sub


In the general decs of module1:

Dim cTick As Integer
cTick = 25

Oops, there
This message was edited by zacemmel on 2002-10-25 19:23

 

[Ivan F Moala]

I don't think your code is complete ?
You will need to Disable the Timer control
to stop the Timer from always updating ?

 

[Yogi]

Thanks again to the Excel community for all of the help.

 

[Yogi]

The 25 second display still flickers after the countdown is complete. I can live with it but would prefer it didn't do this.
Thanks

 

[Wil Moosa]

Looking at Ivan's advise from the 25th.

Sub CountDown()
Dim pausetime As Single
Dim start As Single
Dim finish As Single
Dim totaltime As Single

pausetime = 25 ' Set duration.
start = Timer ' Set start time.

Do While Timer < start + pausetime
DoEvents ' Yield to other processes.
Sheets(1).Range("B2").Value = _
Format(pausetime + (start - Timer), "##")
Loop

finish = Timer ' Set end time.
totaltime = finish - start
End

End Sub


I want the count down followed by some action (a macro getting started). Where do I add Application.Run "Alfabet_A_I"

 

[Joe Was]

Sub CountDown()
Dim pausetime As Single
Dim start As Single
Dim finish As Single
Dim totaltime As Single

pausetime = 25 ' Set duration.
start = Timer ' Set start time.

Do While Timer < start + pausetime
DoEvents ' Yield to other processes.
Sheets(1).Range("B2").Value = _
Format(pausetime + (start - Timer), "##")
Loop

finish = Timer ' Set end time.
totaltime = finish - start

MsgBox "All Done!" '<== Your "Sub" name here, inplace of the MsgBox!

End
End Sub