Countdown Timer

[uniden32]

Hey mates,

I've searched the forums for existing countdown timers, but haven't found any that suited my needs.

I'm looking for a timer that counts down the minutes and seconds based on the current time.

The user would open the spreadsheet, there would be a button they could press that would display a timer based on how many minutes were left in the current half-hour.

(ie; If it were currently 9:15.20, the timer would start at 15.20 and count down. If the time was 9:36.18, the timer would start at 23.42 and count down.)

Once the timer hit 0, it would make a sound, then it would immediately restart at 30.00, and the cycle would continue as long as the the spreadsheet was open.

Thanks in advance,

Ralph

 

[uniden32]

Ok, sorry for the extra post, couldn't figure out how to delete my last post.

Ok, so I've got it running, I have several issues:

1. When it's running for 30 minutes, the timer can lose up to 2 minutes.
2. I need a way to loop it once the timer hits 0, so that it restarts.

Here is my current code:

Dim NextTick As Date

Sub StartTimer()
With ThisWorkbook.Sheets("Data").Range("D2")
    .NumberFormat = "hh:mm:ss"
    .Value = Time
End With
Call TickTock1
Call TickTock
Beep
End Sub
Private Sub TickTock1()
With ThisWorkbook.Sheets("Sheet1").Range("B2")
    .NumberFormat = "mm:ss"
    .Value = ThisWorkbook.Sheets("Data").Range("E3")
End With
End Sub

Private Sub TickTock()
With ThisWorkbook.Sheets("Sheet1").Range("B2")
    .NumberFormat = "mm:ss"
    .Value = ThisWorkbook.Sheets("Sheet1").Range("B2")
    .Value = .Value - (1 / 86400)
    If .Value <= (1 / 86400) Then
        .Value = Time
    End If
End With
NextTick = Now + TimeValue("00:00:01")
Application.OnTime NextTick, "TickTock"

End Sub

Sub StopClock()
On Error Resume Next
Application.OnTime earliesttime:=NextTick, procedure:="TickTock", schedule:=False
On Error GoTo 0
End Sub

As always, thanks in advance,

Ralph