create a count down timer

[smiler44]

I can not seem to work out how to create a count down timer.
The user will enter the length of their break, 15, 30 or 60 minutes in a text box.
I would like the counter to count down in seconds until it reaches zero, updating the textbox every second with the time left before it reaches zero.

A search on Google results in me finding timers to count down the seconds shown in a cell but my attempts to modify them to meet my needs have failed.

The advice is, please.

Thank you in advance
smiler44

 

[ajetrumpet]

attached is a sample of how to countdown. this is a portion of a timeclock i made for myself a long time ago. it is in access, but the VBA is the same for excel. hopefully you can use the code to do what you need....


i made a example for you in excel. that's a better one i think...

 

[smiler44]

Adam,
thank you. Once I have posted a question I try not to just sit back and wait, I do try and find my own solutions.
Having I think done just that I've come back to the forum and seen your post, thanks. Is the Public Function CountDown(NumSeconds As Variant) the one that does the counting down?

with much trial and error I have come up with whats below. perhaps not strictly accurate time wise but the error may be so minimul it may not matter. i have struggeled to get the time in minutes and seconds and so have had to find a work around
smiler44

Private Sub aaa()
    Dim LDate As Date
    Dim lldate As String
    Dim lbdate As String
    Dim beve As String 
    Dim hr As String
    Dim tme As String
    Dim target As String
    Dim mes As String
    Dim ms As String
    Dim bdate As Date
     
    hr = "00:"
    tme = hr & Sheet1.TextBox3.Value  'textbox3 contains the break duration in minutes
    beve = "1" ' number of seconds to subtract from time in textbox3
    
    's denotes that beve is seconds
    LDate = DateAdd("s", -beve, tme)
    lldate = Format(LDate, "hh:mm:ss")
    mes = Mid(lldate, Len(lldate) - 4)
    Sheet1.TextBox3.Value = mes
    'time in textbox3 has now reduced by "a second"
    
    Do Until ms = "00:00" ' do until there is no time left
    pause (1) 'pause for one second
    bdate = DateAdd("s", -beve, mes)
    lbdate = Format(bdate, "hh:mm:ss")
    target = lbdate
    mes = Left(target, Len(target) - 3)
    Sheet1.TextBox3.Value = mes  'time left before sign on is required
    Loop
   
   MsgBox ("sign on is required")
    End Sub
 
Sub pause(seconds As Single)
   Dim TimeEnd As Long
    If seconds > 60 Then
        seconds = 60
    End If
    TimeEnd = Timer + seconds
    If TimeEnd > 86390 Then
        TimeEnd = 0
    End If
        
    Do
        DoEvents
    Loop Until TimeEnd <= Timer
End Sub

 

[ajetrumpet]

looks good to me smiler. way to go. you spawned a FAQ too. I posted a FAQ in that section that shows how to make a timeclock in access. it's better than the ones i posted here. and YES, the coundown function is the one that runs the timer. as the argument should always be ONE.