Add this to a standard code module
Option Explicit
Public nTime As Double
Public Sub StartTimer()
On Error Resume Next
Application.OnTime nTime, "RunTimer", , False
On Error GoTo 0
ActiveSheet.Range("A1").Value = 0
RunTimer
End Sub
Public Sub StopTimer()
Application.OnTime nTime, "RunTimer", , False
End Sub
Public Sub RunTimer()
With ActiveSheet.Range("A1")
.Value = .Value + TimeSerial(0, 0, 1)
.NumberFormat = "hh:mm:ss"
End With
nTime = Now + TimeSerial(0, 0, 1)
Application.OnTime nTime, "RunTimer"
End Sub
To the appropriate worksheet code module
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "H1" '<== change to suit
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If .Value Then
StopTimer
StartTimer
End If
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click on the sheet tab, select
'the View Code option from the menu, and paste the code in.
and to ThisWorkbook code module
Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopTimer
End Sub
Private Sub Workbook_Open()
StartTimer
End Sub
'This is workbook event code.
'To input this code, right click on the Excel icon on the worksheet
'(or next to the File menu if you maximise your workbooks),
'select View Code from the menu, and paste the code
--
HTH
Bob
(there's no email, no snail mail, but somewhere should be gmail in my addy)
