Stopwatch in a userform

tyr443

New Member
Joined
Mar 4, 2016
Messages
34
Office Version
  1. 365
Platform
  1. Windows
Hi,

I have looked around but can't find a thread for this, so I apologize if it has been done, please point me in the right direction in that case.

I would like to create a userform with a stopwatch that can be started, stopped and reset, to record times into a table.

The user would open the form, put a client name, a description of what the time was for e.g. phone call, click start on the stopwatch, once the call is over they click stop, then they can click ok to add these three things to a table.

I'm fine adding info from textboxes to a table, but creating a stopwatch in a form is where I am stuck, sorry I am a beginner.

If it is any benefit, the stopwatch only needs to be minutes an hours.

Thank you in advance for taking the time to respond and patience to help me.
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Here is a direct method without the UserForm :

VBA Code:
Option Explicit

Sub Button1_Click()
Static Ct
Dim NxRw As Long
If Range("A10") <> "" Then
    NxRw = 10
Else
    Exit Sub
End If
If IsEmpty(Range("B10")) Then
    Ct = Ct + 1
    [B10] = Now
ElseIf IsEmpty(Range("C10")) Then
    Ct = Ct + 1
    [C10] = Now
Else
    NxRw = Cells(Rows.Count, "C").End(xlUp).Row + 1
    If Cells(NxRw, "A").Value <> "" Then
        If Ct Mod 2 <> 0 Then
            Cells(NxRw, "C").Value = Now
            Ct = Ct + 1
        Else
            Cells(NxRw, "B") = Now
            Ct = Ct + 1
        End If
    Else
        Exit Sub
    End If
End If
If Cells(NxRw, "C").Value <> "" Then
    Cells(NxRw, "D").Value = Cells(NxRw, "C").Value - Cells(NxRw, "B").Value
End If
Range("B10:D" & NxRw).NumberFormat = "hh:mm:ss"
End Sub

Enter time in Col A, Click button once (start time)
Click again End Time and Total Time

 
Upvote 0
Here is a direct method without the UserForm :

VBA Code:
Option Explicit

Sub Button1_Click()
Static Ct
Dim NxRw As Long
If Range("A10") <> "" Then
    NxRw = 10
Else
    Exit Sub
End If
If IsEmpty(Range("B10")) Then
    Ct = Ct + 1
    [B10] = Now
ElseIf IsEmpty(Range("C10")) Then
    Ct = Ct + 1
    [C10] = Now
Else
    NxRw = Cells(Rows.Count, "C").End(xlUp).Row + 1
    If Cells(NxRw, "A").Value <> "" Then
        If Ct Mod 2 <> 0 Then
            Cells(NxRw, "C").Value = Now
            Ct = Ct + 1
        Else
            Cells(NxRw, "B") = Now
            Ct = Ct + 1
        End If
    Else
        Exit Sub
    End If
End If
If Cells(NxRw, "C").Value <> "" Then
    Cells(NxRw, "D").Value = Cells(NxRw, "C").Value - Cells(NxRw, "B").Value
End If
Range("B10:D" & NxRw).NumberFormat = "hh:mm:ss"
End Sub

Enter time in Col A, Click button once (start time)
Click again End Time and Total Time
Thanks for that, this is what I have managed to find so far googling around, problem is I can't get it to work in a user form with a label or something showing the time.
 
Upvote 0
VBA Code:
Option Explicit

Private Sub BtnRaz_Click()
    mTimer2.TimerOff
    LblTemps.Caption = "00:00:00"

    With TButton1
        .Caption = "Start"
        .ForeColor = &H8000&
        .Value = False
    End With
End Sub

Private Sub LblTemps_Click()

End Sub

Private Sub TButton1_Click()
    With TButton1
        If .Value = True Then
            .Caption = "Stop"
            .ForeColor = &H80&
            mTimer2.TimerOn 1000
        Else
            .Caption = "Start"
            .ForeColor = &H8000&
            mTimer2.TimerOff
        End If
    End With
End Sub

Private Sub UserForm_Initialize()
    With TButton1
        .Caption = "Start"
        .ForeColor = &H8000&
        .Value = False
    End With
End Sub

Private Sub UserForm_Terminate()
    mTimer2.TimerOff
    Unload Me
End Sub

Download workbook : Task Timer.xlsm
 
Upvote 0
VBA Code:
Option Explicit

Private Sub BtnRaz_Click()
    mTimer2.TimerOff
    LblTemps.Caption = "00:00:00"

    With TButton1
        .Caption = "Start"
        .ForeColor = &H8000&
        .Value = False
    End With
End Sub

Private Sub LblTemps_Click()

End Sub

Private Sub TButton1_Click()
    With TButton1
        If .Value = True Then
            .Caption = "Stop"
            .ForeColor = &H80&
            mTimer2.TimerOn 1000
        Else
            .Caption = "Start"
            .ForeColor = &H8000&
            mTimer2.TimerOff
        End If
    End With
End Sub

Private Sub UserForm_Initialize()
    With TButton1
        .Caption = "Start"
        .ForeColor = &H8000&
        .Value = False
    End With
End Sub

Private Sub UserForm_Terminate()
    mTimer2.TimerOff
    Unload Me
End Sub

Download workbook : Task Timer.xlsm

I have tried the workbook you attached, I had to change it to 64bit using PtrSafe, but then it gives me a type mismatch and the debugger points me to:
VBA Code:
Sub TimerOn(Interval As Long)
    TimerID = SetTimer(0, 0, Interval, AddressOf Chrono)
End Sub
 
Upvote 0
I won't be able to assist with the error you are experiencing. I too am using the workbook on 64 bit (Win10) and the project runs here without issue.

Perhaps someone else on the Forum can assist you.
 
Upvote 0
There is a difference between the bitness of the Windows OS and Excel.
@Logit most likely uses Excel 32-bit (on Windows 64-bit) while @tyr443 uses Excel 64-bit.
The Win API declarations below should fix the current issue.

VBA Code:
#If VBA7 Then
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If
 
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,150
Members
448,552
Latest member
WORKINGWITHNOLEADER

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top