Timer on Excel VBA - vba

Question

Dim StartTime As Date
Public Declare Function SetTimer Lib "user32" ( _
ByVal HWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
Public TimerID As Long, TimerSeconds As Single, tim As Boolean
Dim Counter As Long
Sub StartTimer()
'~~ Set the timer for 1 second
TimerSeconds = 1
TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub
'~~> End Timer
Sub EndTimer()
On Error Resume Next
KillTimer 0&, TimerID
End Sub
Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
ByVal nIDEvent As Long, ByVal dwTimer As Long)
'~~> Update value in Sheet 1
Sheet1.Range("H6").Value = Time - StartTimer
End Sub
Public Sub sheet()
Sheets("1").Activate
StartTime = Time
Call Module1.StartTimer
End Sub
I would like to write a code which show timer how much time user working on the Worksheet.
Example there is a start button in sheet1 when user click on start button then it will active sheet2 then a timer will run in cell A1. if the timer is 30 min then the workbook save & close.

Answer 1

Try this
Create Button and assign to the following macro
Option Explicit
Sub NewTimer()
Dim Start As Single
Dim Cell As Range
Dim CountDown As Date
'// Store timer as variable
Start = Timer
'// Format cell A1 to 24Hrs eg: 00:00:00
With Range("A1")
.NumberFormat = "HH:MM:SS;#"
End With
Set Cell = Sheet1.Range("A1")
'// This is the starting value. 30 Second
CountDown = TimeValue("00:00:30")
'// Set cell to the starting value
Cell.Value = CountDown
'Keep looping until A1 hits zero or
Do While Cell.Value > 0
'Update the cell. Timer - Starting number is seconds
Cell.Value = CountDown - TimeSerial(0, 0, Timer - Start)
DoEvents
Loop
ThisWorkbook.Save
ThisWorkbook.Close
Application.Quit
End Sub
Thanks to Dick Kusleika See Example