VBA UserForm - Custom count-down timer for minutes working but cannot implement custom seconds

Question

I have implemented a count-down timer which is now working for whole minutes entered into a text box by the user (e.g. 05:00), however I am struggling with implementing functionality for the user to enter their own seconds as well.

The userform has a button "Timercustom", when clicked a routine will update every second a text box "TextBox3" in the format 00:00 (e.g.05:00) to countdown from the initial to 00:00.

Could someone with more VBA experience help to make adjustments so that extra seconds that are added are counted down as well? I have tried several hours to do this, but stripped back to the working code below for whole minutes only for clarity.

'Initialisation function
Private Sub UserForm_Initialize()
Dim M As Double, S As Double
M = Int(CDbl(AllowedTime))
S = (CDbl(AllowedTime) - Int(CDbl(AllowedTime))) * 60
 With TextBox1
    .Value = Format(CStr(M), "15") & ":" & Format(CStr(S), "00")
End With

With TextBox2
    .Value = Format(CStr(M), "45") & ":" & Format(CStr(S), "00")
End With

With TextBox3
    .Value = Format(CStr(M), "5") & ":" & Format(CStr(S), "00")
End With
End Sub


'main function to start the timer
Private Sub Timercustom_Click()
Dim t, E, M As Double, S As Double
Dim AllowedTime As Integer
Dim TextStrng As String
Dim Result() As String
Dim tempS As Double
Dim firstRun As Boolean


firstRun = True

TextStrng = TextBox3.Value
Result() = Split(TextStrng, ":")

AllowedTime = Result(0)
t = Timer

Do
    If Timer - t < 0 Then
        Unload UserForm1
        MsgBox "Error encountered - start again"
        Exit Sub
    End If
    E = CDbl(Time) * 24 * 60 * 60 - t 'elapsed time in secs
    M = (CDbl(AllowedTime) - 1) - Int(E / 60)

    'this just avoids a weirdity where the seconds initially goes to 00:0-1, for some reason
    If tempS < 0 Then
    tempS = Result(1)
    End If

    S = tempS

    With TextBox3
        .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00")
    End With
    DoEvents
Loop Until (Timer - t) / 60 >= CDbl(AllowedTime) Or UserForm1.Visible = False 

End Sub

Note that if you declare Dim t, E, M As Double that t and E are of type Variant you must specify a type for every variable: Dim t As Double, E As Double, M As Double — Pᴇʜ
– Pᴇʜ, Commented Jan 22, 2019 at 13:07
AllowedTime is defined in Timercustom_Click but used in UserForm_Initialize. Always use Option Explicit to check variable declarations. — Vincent G
– Vincent G, Commented Jan 22, 2019 at 13:21

Pᴇʜ · Accepted Answer · 2019-01-22 14:00:18Z

1

Here is an example of how to do the calculations for the timer and how to format input/output.

You need to validate your user input format and convert it to hh:mm:ss so eg if your user inputs 01:15 which is mm:ss you need to convert it into 00:01:15. This format can then be converted into a real time using TimeValue and with CDbl(TimeValue(UserInput)) * 24 * 60 * 60 you get the amount of seconds of that time.

Note that we need to convert the time into seconds because your Timer is calculating in seconds.

SecondsToRun - (Timer - TimerStart) gives you the amount of seconds that are left on your timer. And with Format$((SecondsToRun - (Timer - TimerStart)) / 24 / 60 / 60, "hh:mm:ss") you can format the seconds as human readable time.

Option Explicit

Public Sub TimerExample()
    Dim UserInput As String
    UserInput = "01:15" 'this is what the user inputs and how long the timer should run

    'validate userinput und ensure hh:mm:ss format
    Select Case Len(UserInput) - Len(Replace$(UserInput, ":", ""))
        Case 2 'input format is hh:mm:ss

        Case 1 'input format is mm:ss
            UserInput = "00:" & UserInput
        Case 0 'input format is ss
            UserInput = "00:00:" & UserInput
        Case Else
            MsgBox "invalid input"
            Exit Sub
    End Select

    'we need to convert the string UserInput into a double and
    'convert it into seconds (Timer uses seconds!)
    Dim SecondsToRun As Long
    SecondsToRun = CDbl(TimeValue(UserInput)) * 24 * 60 * 60

    Dim TimerStart As Double
    TimerStart = Timer 'remember when timer starts

    Do
        Cells(1, 1).Value = Format$((SecondsToRun - (Timer - TimerStart)) / 24 / 60 / 60, "hh:mm:ss")
        'count backwards from 01:15 format as hh:mm:ss and output in cell A1

        DoEvents
    Loop While TimerStart + SecondsToRun > Timer 'run until SecondsToRun are over
End Sub

So this code will start a timer that counts backwards from 01:15 (1 minute, 15 seconds) backwards to 0. The output will be in cell A1 as follows:

00:01:15
00:01:14
00:01:13
00:01:12
00:01:11
00:01:10
00:01:09
00:01:08
and so on.

edited Jan 22, 2019 at 14:00

answered Jan 22, 2019 at 13:39

Pᴇʜ

57.9k10 gold badges55 silver badges75 bronze badges

Sign up to request clarification or add additional context in comments.

4 Comments

Zac Over a year ago

Great solution, but I think OP wants to display the count down in a TextBox in a Form. Not that you need to change much in your code to achieve that

Pᴇʜ Over a year ago

@Zac well left some work for him. I chose to keep it simple so anyone can just copy/paste and run the code (without the need of setting up a UserForm etc.). OP just needs to adjust the UserInput = "01:15" and output Cells(1, 1).Value = … to his TextBoxes.

user1088793 Over a year ago

Hi Peh, just wanted to thank you for this most elegant solution. Answers like these always make me feel totally useless in the way I approach problems, but inspire at the same time. Many thanks

Zac Over a year ago

@Pᴇʜ: fare shout :)

simple-solution · Accepted Answer · 2019-01-22 15:31:49Z

I have worked with the "Peh" solution but used the ontime event.
The result is not predictable depending on the exact start time:

How would you improve this?
1. Timer should not end with positive value 00:01!
2. Timer should not end with negative value! (also displayed as 00:01)

Option Explicit
Dim TimerStart As Double
Dim SecondsToRun As Long
Dim UserInput As String
Dim LatestStartTime As Variant
Dim rowCt As Integer
Dim colCt As Integer

Sub ResetColCount()
    colCt = 0
    Range("A1:Z10").Clear
End Sub

Public Sub TimerExample()
    UserInput = "00:03" 'this is what the user inputs and how long the timer should run
    rowCt = 0
    colCt = colCt + 1

    'validate userinput und ensure hh:mm:ss format
    Select Case Len(UserInput) - Len(Replace$(UserInput, ":", ""))
        Case 2 'input format is hh:mm:ss

        Case 1 'input format is mm:ss
            UserInput = "00:" & UserInput
        Case 0 'input format is ss
            UserInput = "00:00:" & UserInput
        Case Else
            MsgBox "invalid input"
            Exit Sub
    End Select

    'we need to convert the string UserInput into a double and
    'convert it into seconds (Timer uses seconds!)
    SecondsToRun = CDbl(TimeValue(UserInput)) * 24 * 60 * 60

    TimerStart = Timer 'remember when timer starts
    Cells(1 + rowCt, colCt).Value = Format$((SecondsToRun - (Timer - TimerStart)) / 24 / 60 / 60, "hh:mm:ss")
    rowCt = rowCt + 1
    LatestStartTime = Now() + TimeValue(UserInput) + TimeValue("00:00:01")

    Application.OnTime Now() + TimeValue("00:00:01"), "UpdateTime", LatestStartTime

End Sub

Sub UpdateTime()
    Cells(1 + rowCt, colCt).Value = Format$((SecondsToRun - (Timer - TimerStart)) / 24 / 60 / 60, "hh:mm:ss")
    rowCt = rowCt + 1
    If TimerStart + SecondsToRun > Timer Then
        Application.OnTime Now() + TimeValue("00:00:01"), "UpdateTime", LatestStartTime
    End If
End Sub

Collectives™ on Stack Overflow

VBA UserForm - Custom count-down timer for minutes working but cannot implement custom seconds

2 Answers 2

4 Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

4 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related