A simple countdown timer in userform

[Wicked_]

Hi.

I've googled a lot, tried alot, but cant get it to work, so i'll ask here.

Im looking for a simple way to make a countdown timer in a label.

I want it so when the userform loads, a coundown timer from 5 min shows in a label, counting down, in min and sec.

Does anyone know how to do this?

 

[Wicked_]

Hopefully the last question hehe.
Lets say i have a button, how would i code it, so it will stop the timer ? Like aborting it kinda.

 

[DanteAmor]

Use this

Private Sub CommandButton1_Click()
    On Error Resume Next
    Application.OnTime EarliestTime:=ahora, Procedure:="toReturn", Schedule:=False
    On Error GoTo 0
    MsgBox "Process aborted"
    End
End Sub

 

[Wicked_]

EDIT: It flashes and reopens only when i got a other workbook open in the background. Just to clarify

Hi again.

When i tried that, it closed by userform, instead of disabling the timer itself hmm.

Also i got a other problem, what im trying to do is when the timer reaches 0, the book shall save and quit: Code below.
That works when the timer reaches 0, it closes perfectly, (the code is if its the only workbook active, or multiple up).
But if i try to use this code to manually save the program (with a button), it flashes, and reopens again, even i want it just to save and close (and stay closed)

The code for saving with button:

If Application.Workbooks.Count = 1 Then
ThisWorkbook.Save
Application.DisplayAlerts = True
Application.Quit




The code i use from you, just modified, works good when the timer runs out, does what i want to:

Public ahora, g5, h5, i5
Const wTime = "00:05:00" 'time for test






Sub countdown()



i5 = h5 - g5
h5 = Time
Label1.Caption = Format(TimeValue(wTime) - TimeValue(Format(i5, "hh:mm:ss")), "hh:mm:ss")

If TimeValue(Label1.Caption) <= 0 Then
On Error Resume Next
Application.OnTime EarliestTime:=ahora, Procedure:="toReturn", Schedule:=False
On Error GoTo 0
'MsgBox "Time's Up!"



If Application.Workbooks.Count = 1 Then
ThisWorkbook.Save
Application.DisplayAlerts = True
Application.Quit
Else
ThisWorkbook.Save
Application.DisplayAlerts = True
ThisWorkbook.Close
End If






Exit Sub
End If
Application.OnTime EarliestTime:=Now + TimeValue("00:00:01"), Procedure:="toReturn", Schedule:=True

End Sub



Then i tried to copy and modify the code that works, put it in a module, and made the save button to "Call mancountdown", with this code:

Const wmTime = "00:00:00" 'time for test
Sub mancountdown()










i5 = h5 - g5
h5 = Time
UserForm1.Label1.Caption = Format(TimeValue(wmTime) - TimeValue(Format(i5, "hh:mm:ss")), "hh:mm:ss")

If TimeValue(UserForm1.Label1.Caption) <= 0 Then
On Error Resume Next
Application.OnTime EarliestTime:=ahora, Procedure:="toReturn", Schedule:=False
On Error GoTo 0
'MsgBox "Time's Up!"



If Application.Workbooks.Count = 1 Then
ThisWorkbook.Save
Application.DisplayAlerts = True
Application.Quit
Else
ThisWorkbook.Save
Application.DisplayAlerts = True
ThisWorkbook.Close
End If






Exit Sub
End If
Application.OnTime EarliestTime:=Now + TimeValue("00:00:00"), Procedure:="toReturn", Schedule:=True

End Sub

But with that, it just closes and quickly reopens again hmm.

Do you got any suggestions?

Use this

Private Sub CommandButton1_Click()
    On Error Resume Next
    Application.OnTime EarliestTime:=ahora, Procedure:="toReturn", Schedule:=False
    On Error GoTo 0
    MsgBox "Process aborted"
    End
End Sub

 

[DanteAmor]

I made adjustments to the code, try the following:

Dim ahora, g5, h5, i5
Const wTime = "00:00:05"    'time for test


Private Sub UserForm_Initialize()


    g5 = Time
    h5 = Time
    i5 = 0
    Label1.Caption = Format(TimeValue(wTime), "hh:mm:ss")
    'ahora = Now
    Call countdown


End Sub


Sub countdown()
    
    i5 = h5 - g5
    h5 = Time
    Label1.Caption = Format(TimeValue(wTime) - TimeValue(Format(i5, "hh:mm:ss")), "hh:mm:ss")
    
    If TimeValue(Label1.Caption) <= 0 Then
        Application.OnTime EarliestTime:=ahora + TimeValue("00:00:01"), Procedure:="toReturn", Schedule:=False
        MsgBox "Time's Up!"
    Else
        ahora = Now
        Application.OnTime EarliestTime:=ahora + TimeValue("00:00:01"), Procedure:="toReturn", Schedule:=True
    End If
    
End Sub


Private Sub CommandButton1_Click()
    'to stop clock
    Application.OnTime EarliestTime:=ahora + TimeValue("00:00:01"), Procedure:="toReturn", Schedule:=False
End Sub


Private Sub CommandButton2_Click()
    'to save
    Application.OnTime EarliestTime:=ahora + TimeValue("00:00:01"), Procedure:="toReturn", Schedule:=False
    ThisWorkbook.Save
    Application.Quit
End Sub

 

[Wicked_]

Now the save button works perfect, but if i let the timer reach 0, i get the following error:

Run-time error '1004'
Method 'OnTime' of object '_Application' failed.

I made adjustments to the code, try the following:

Dim ahora, g5, h5, i5
Const wTime = "00:00:05"    'time for test


Private Sub UserForm_Initialize()


    g5 = Time
    h5 = Time
    i5 = 0
    Label1.Caption = Format(TimeValue(wTime), "hh:mm:ss")
    'ahora = Now
    Call countdown


End Sub


Sub countdown()
    
    i5 = h5 - g5
    h5 = Time
    Label1.Caption = Format(TimeValue(wTime) - TimeValue(Format(i5, "hh:mm:ss")), "hh:mm:ss")
    
    If TimeValue(Label1.Caption) <= 0 Then
        Application.OnTime EarliestTime:=ahora + TimeValue("00:00:01"), Procedure:="toReturn", Schedule:=False
        MsgBox "Time's Up!"
    Else
        ahora = Now
        Application.OnTime EarliestTime:=ahora + TimeValue("00:00:01"), Procedure:="toReturn", Schedule:=True
    End If
    
End Sub


Private Sub CommandButton1_Click()
    'to stop clock
    Application.OnTime EarliestTime:=ahora + TimeValue("00:00:01"), Procedure:="toReturn", Schedule:=False
End Sub


Private Sub CommandButton2_Click()
    'to save
    Application.OnTime EarliestTime:=ahora + TimeValue("00:00:01"), Procedure:="toReturn", Schedule:=False
    ThisWorkbook.Save
    Application.Quit
End Sub

 

[DanteAmor]

change this:

    If TimeValue(Label1.Caption) <= 0 Then
        [COLOR=#0000ff]On Error Resume Next[/COLOR]
        Application.OnTime EarliestTime:=ahora + TimeValue("00:00:01"), Procedure:="toReturn", Schedule:=False
        MsgBox "Time's Up!"
    Else
        ahora = Now
        Application.OnTime EarliestTime:=ahora + TimeValue("00:00:01"), Procedure:="toReturn", Schedule:=True
    End If

 

[Wicked_]

That worked like a charm!

Thank you so much for all your support Dante!
Really appreciate it.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.