Start / Pause timer Button

[N323100]

I want to create 1 button with two function for my timer it should be like Start and Pause I' using userform.

Dim NextTick As Date, t As Date
Sub StartStopWatch()
t = Time
Call StartTimer
End Sub

Sub StartTimer()

NextTick = Time + TimeValue("00:00:01")
ActivityTracker.TextBox3 = Format(NextTick - t - TimeValue("00:00:01"), "hh:mm:ss")
Application.OnTime NextTick, "StartTimer"
End Sub

Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=NextTick, Procedure:="StartTimer", Schedule:=False
End Sub

Private Sub CommandButton5_Click()
StartStopWatch

End Sub

[LJMetzger]

Hi,

The following code will pause timing. When PauseOrRestartTimer() is called a second time, the count will resume from the pause time. Slightly different logic is required to keep the timer running while the display is paused.

Option Explicit

Dim NextTick As Date, t As Date, xElapsedTime As Date, xPreviousElapsedTime As Date
Dim bTimerIsActive As Boolean
Dim bTimerIsPaused As Boolean

Sub StartStopWatch()

Call StopTimer

bTimerIsActive = True
bTimerIsPaused = False
xPreviousElapsedTime = 0
t = Now()
Call StartTimer
End Sub

Sub PauseOrRestartTimer()

  If bTimerIsActive = True Then
  
    'Toggle Timer is Paused Flag
    bTimerIsPaused = Not bTimerIsPaused
    
    If bTimerIsPaused = False Then
      t = Time
      Call StartTimer
    End If
  
  End If

End Sub

Sub StartTimer()

NextTick = Time + TimeValue("00:00:01")
xElapsedTime = xPreviousElapsedTime + Now() - t
ActivityTracker.TextBox3 = Format(xElapsedTime, "hh:mm:ss")
If bTimerIsPaused = True Then
  xPreviousElapsedTime = xPreviousElapsedTime + Now() - t
Else
  Application.OnTime NextTick, "StartTimer"
End If

Debug.Print Now, Format(xElapsedTime, "hh:mm:ss")

End Sub

Sub StopTimer()
bTimerIsActive = False
bTimerIsPaused = False
On Error Resume Next
Application.OnTime EarliestTime:=NextTick, Procedure:="StartTimer", Schedule:=False

xPreviousElapsedTime = 0
t = 0
End Sub

NOTE: For resolution to one hundredth of a second see Timer. http://www.excelfunctions.net/vba-timer-function.html


Lewis

[N323100]

Thanks for the inputs.

I attached the file and put the following codes accordingly, but its not working properly I'm not sure if I did it right?

Thank you

[LJMetzger]

One small error.

In the UserForm code module, you used 'StartTimer()', when 'StartStopWatch()' should have been used.

Private Sub CommandButton1_Click()
StartStopWatch
End Sub

[N323100]

Thank you this is a great help!

[N323100]

I have a follow up question. I want to trigger the StartStopWatch but completing to fillin' up the ComboBox6 but the only problem if the time that the user change the information in ComBobox6 the StartStopWatch will return to 00:00:01

here are the details of my ComboBox

ComboBox6.AddItem "Completed"
    ComboBox6.AddItem "Pending - Team Meeting"
    ComboBox6.AddItem "Pending - 1st Break"
    ComboBox6.AddItem "Pending - Lunch Break"
    ComboBox6.AddItem "Pending - 2nd Break"
    ComboBox6.AddItem "Pending - Coaching"
    ComboBox6.AddItem "Pending - End of Shift"

and also I have this code in submit button

Me.TextBox3.Value = ""

but the textbox or time still running it doesn't remove in textbox. I tried to pause the time and click the submit button and the time in textbox was removed. maybe it should be stop the time first before it was cleared or removed in textbox?
I would appreciate if there is a easy way to my dilemma.

Thank you

[LJMetzger]

The following may help you. If not I will come up with a working example for you:
a. StartStopWatch() should only be called when you want to start from 0:00.
b. PauseOrRestartTimer() will 'pause' the 'stopwatch' if it is running. PauseOrRestartTimer() will make the 'stopwatch' continue from the value that is currently in the display, if it was 'paused'.

[N323100]

Yeah I'm using that code and it works perfectly. The only problem is I have a submit button that will transfer the data including the time into another sheet, once the submit button was click by the user all of the information in userform will be empty or delete to enter a new information again. but the time still shows up in textbox3 even I already put a code the delete or empty the textbox. Thank you for helping me with this project.

[LJMetzger]

The only problem is I have a submit button that will transfer the data including the time into another sheet, once the submit button was click by the user all of the information in userform will be empty or delete to enter a new information again. but the time still shows up in textbox3 even I already put a code the delete or empty the textbox.

I need to see a sample file that demonstrates the problem. The symptoms suggest that data must be stored somewhere at the beginning of the 'Submit' routine, and then the data must be restored later.

[N323100]

I will upload the file....thanks

[N323100]

Please see attached file.. Please refer to Activity Tracker Userform. Thanks for patiently helping

[LJMetzger]

If I understand your question correctly, after you select 'Submit', you want TextBox3 to be blank.

You cleared the contents of the TextBox, but you did not stop the timer first, so the timer continued to run, and kept updating the value in TextBox3. If you add the item in red below to the UserForm code, you will probably fix your problem:

Private Sub CommandButton4_Click()

'Code deleted to save space

'auto save
ActiveWorkbook.Save
INIT_FORM
Call StopTimer
TextBox3.Value = Empty
End Sub

Lewis

[N323100]

Hi Thanks you, I tried the above code but still the timer shows after the submit button.

[LJMetzger]

Sorry for the problem. When CommandButton4 (i.e. Submit) called MsgBox it Timer requests queued up, and caused StopTimer() to not work properly. StopTimer() must be the first command in UserForm code for CommandButton4_Click() (Submit) and also in CommandButton3_Click() (Reset/Close).

The attached file implements those changes and hopefully will work the way you want.

In the ActivityTracker UserForm code module:

Private Sub CommandButton3_Click()
Call StopTimer
Debug.Print "StopTimer() called from CommandButton3 at " & Now()
If CommandButton3.Caption <> "Close" Then INIT_FORM: Exit Sub
Unload Me
Worksheets("Task").Activate
'auto save
ActiveWorkbook.Save
End Sub

Private Sub CommandButton4_Click()
Dim RowCounter  As Long
Dim rowCount    As Long
Dim ctrl        As Control


Call StopTimer
Debug.Print "StopTimer() called from CommandButton4 at " & Now()
If MsgBox("Submit RFP Activity?", vbQuestion + vbYesNo, "") = vbNo Then GoTo endmacro


rowCount = Worksheets("Activity Sheet").Range("A1").CurrentRegion.Rows.Count
With Worksheets("Activity Sheet").Range("A" & rowCount + 1)
    'Form to Database
    .Offset(RowCounter, 0).Value = Now()
    .Offset(RowCounter, 1).Value = Me.TextBox2.Value ' RFP Name
    .Offset(RowCounter, 2).Value = Me.ComboBox3.Value ' Request Type
    .Offset(RowCounter, 3).Value = Me.ComboBox4.Value ' # of Questions
    .Offset(RowCounter, 4).Value = Me.ComboBox5.Value ' Print Format
    .Offset(RowCounter, 5).Value = Me.ComboBox6.Value ' Status
    '.Offset(RowCounter, 6).Value = Format(Me.TextBox3.Value, "hh:mm:ss")   'Start Time
    '.Offset(RowCounter, 7).Value = Format(Me.TextBox4.Value, "hh:mm:ss")   'End Time
    .Offset(RowCounter, 8).Value = Format(Me.TextBox3.Value, "hh:mm:ss")   'Time Spent
    .Offset(RowCounter, 8).NumberFormat = "hh:mm:ss" ' Time Spent Format
    

End With


'MessageBox
 MsgBox "Data Added", vbOKOnly + vbInformation, ""
endmacro:

Dim OutMail As Object
Dim OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

If Me.ComboBox6.Value = "Completed" And Me.ComboBox3.Value <> "First Pass" Then ' Email Notification

With Application
    .EnableEvents = False
    .ScreenUpdating = False
  End With

 On Error Resume Next
 
 With OutMail
       .Display
        If Me.ComboBox7.Value = "Name1" Then
        .To = "[email protected]"
        End If
        If Me.ComboBox7.Value = "Name2" Then
        .To = "mail@[email protected]"
        End If
        If Me.ComboBox7.Value = "Name3" Then
        .To = "[email protected]"
        End If
        .CC = ""
        .BCC = ""
        .Subject = TextBox2.Value & " - Review Notification "
        .Body = GetMailBody()
        .Display 'change to .send if you want the email sent automatically
          End With
     On Error GoTo 0
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
   End With

    Set OutMail = Nothing
    Set OutApp = Nothing
 End If


'Clear Data
Me.TextBox2.SetFocus

'auto save
ActiveWorkbook.Save
INIT_FORM
TextBox3.Value = Empty
End Sub

[N323100]

This is perfect! Thank you for your BIG Help with this project.

Now you see the userform for activity tracker I'm planning to remove the Start Time button and leave the Pause/Resume button, I want to start the time if the TextBox and ComboBox has a information on it, before a I tried to create that conditional but if there is a chance the a user change something on any of the textbox or combobox the Timer Restart to 0. Sorry if I make everything complicated

[LJMetzger]

It was my pleasure to help. When I have a lot of options like you have on the UserForm, I find the logic to be easier to control if I:
a. Create separate CommandButtons for each task, instead of sharing.
b. Create a separate Sub to Display or Hide CommandButtons as required.

For example: When the UserForm is opened, the 'Start' CommandButton is visible and the 'Pause' CommandButton is not visible.
When the timer starts, then the 'Start' CommandButton is not visible, and the 'Pause' CommandButton is visible.

[N323100]

Actually my plan is to removed the Start Button and put a conditional statement if all the corresponding textbox and combox is not empty the start will start thank you for all the help

[N323100]

Hi I got an issue again in emptying the Timer

Reset Button under different UserForm.

Private Sub CommandButton3_Click()
Call StopTimer1
Debug.Print "StopTimer1() called from CommandButton3 at " & Now()
If CommandButton3.Caption <> "Close" Then INIT_FORM: Exit Sub
Unload Me
Worksheets("Task").Activate
'auto save
ActiveWorkbook.Save

If CommandButton6.Caption = "Resume" Then
CommandButton6.Caption = "Pause"
End If
End Sub

Thank you,

[LJMetzger]

Hi,

I can't see anything wrong with the code. My speculation is that there is something somewhere that says 'timer' instead of 'timer1'.

Instead of creating multiple timers see the attached file which contains the following code changes in red, that should allow you to use the same timer code for all your UserForms.

In the ThisWorkbook code module (to make sure the timer terminates properly):

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Call StopTimer
End Sub

In the ActivityTracker UserForm code module (to make sure the timer terminates properly):

Private Sub UserForm_Terminate()
  Call StopTimer
End Sub

In ordinary code module module2 (timer code):

Option Explicit

'NOTE: 'Public' means the variable can be accessed by any routine in any module in the file
'      'Dim' or 'Private' means the variable can ONLY be accessed by routines in THIS module
Public myGblUserFormObject As Object
Public sGblStopWatchTextBoxName As String
Public sGblPauseResumeCommandButtonName As String

Dim NextTick As Date, t As Date, xElapsedTime As Date, xPreviousElapsedTime As Date
Dim bTimerIsActive As Boolean
Dim bTimerIsPaused As Boolean

Sub StartStopWatch()

Debug.Print "StartStopWatch() called at " & Now()

Call StopTimer

bTimerIsActive = True
bTimerIsPaused = False
xPreviousElapsedTime = 0
t = Now()
Call StartTimer
End Sub

Sub PauseOrRestartTimer()

Debug.Print "PauseOrRestartTimer() called at " & Now()

  If bTimerIsActive = True Then
  
    'Toggle Timer is Paused Flag
    bTimerIsPaused = Not bTimerIsPaused
    myGblUserFormObject.Controls(sGblPauseResumeCommandButtonName).Caption = "Resume"
    
    If bTimerIsPaused = False Then
      t = Time
      myGblUserFormObject.Controls(sGblPauseResumeCommandButtonName).Caption = "Pause"
      Call StartTimer
      
    End If
  
  End If

End Sub
Sub StartTimer()

Debug.Print "StartTimer() called at " & Now()

xElapsedTime = xPreviousElapsedTime + Now() - t
myGblUserFormObject.Controls(sGblStopWatchTextBoxName) = Format(xElapsedTime, "hh:mm:ss")
If bTimerIsPaused = True Then
  xPreviousElapsedTime = xPreviousElapsedTime + Now() - t
Else
  NextTick = Time + TimeValue("00:00:01")      'July 23, 2017 - was first line in this routine
  Application.OnTime NextTick, "StartTimer"
End If

Debug.Print Now, Format(xElapsedTime, "hh:mm:ss")

End Sub

Sub StopTimer()
Debug.Print "StopTimer() called at " & Now()
bTimerIsActive = False
bTimerIsPaused = False
On Error Resume Next
Application.OnTime EarliestTime:=NextTick, Procedure:="StartTimer", Schedule:=False

xPreviousElapsedTime = 0
t = 0

End Sub

In the Task Sheet (Sheet2) code module:

Private Sub CommandButton5_Click()
ActiveWorkbook.Save
Worksheets("Activity Sheet").Activate          ' the worksheet you want to be active / selected

Set myGblUserFormObject = ActivityTracker
sGblStopWatchTextBoxName = "TextBox3"
sGblPauseResumeCommandButtonName = "CommandButton6"

myGblUserFormObject.Show

End Sub

If this does not solve your problem, please upload a sample file that does not work properly.

Lewis

[N323100]

Wow this is perfect!! Thank you once again!!

[N323100]

Hi I have a different question but now once is replying, can you help me with that?

[N323100]

https://www.excelforum.com/excel-pro...ml#post4706494