Four buttons on a worksheet, Start, Stop, Mark and Clear, linked to 4 macros.
Sub StartButton()
Rem set named value StartTime to Now
ThisWorkbook.Names.Add Name:="StartTime", RefersTo:="=" & CDbl(Now())
Rem mark that timer is on
LastCellInA.Interior.Color = vbYellow
End Sub
Sub StopButton()
Dim StartTime As Date
On Error Resume Next
StartTime = CDate(Evaluate(Names("StartTime").RefersTo))
On Error GoTo 0
If 0 < StartTime Then
Rem if timer is running
With LastCellInA
.Interior.ColorIndex = xlNone
Rem write interval
With .Offset(0, 2)
.Value = Now() - StartTime
.NumberFormat = "h:mm:ss"
End With
Rem calculate adjusted start time
With .Offset(0, 1)
.Value = .Offset(0, 1).Value + .Offset(0, -1).Value
.NumberFormat = "h:mm:ss"
End With
Rem prepare next row
With .Offset(1, 0)
.Value = .Offset(-1, 1).Value
.NumberFormat = "h:mm:ss"
End With
End With
Rem turn off timer by setting name StartTime to 0
ThisWorkbook.Names.Add Name:="StartTime", RefersTo:="=0"
End If
End Sub
Sub MarkButton()
If ThisWorkbook.Names("StartTime").RefersTo <> "=0" Then
Call StopButton
Call StartButton
End If
End Sub
Sub ClearButton()
Dim strPrompt As String
If ThisWorkbook.Names("StartTime").RefersTo <> "=0" Then
strPrompt = "The timer is running" & vbCr & vbCr
End If
strPrompt = strPrompt & "Clear data?" & vbCr & "There is no un-do."
If MsgBox(strPrompt, vbYesNo) = vbYes Then
Call StopButton
With LastCellInA
.Resize(1, 3).EntireColumn.ClearContents
.EntireColumn.Cells(1, 1).Value = 0
End With
End If
End Sub
Function LastCellInA()
With ThisWorkbook.Sheets("Sheet1")
Set LastCellInA = .Cells(.Rows.Count, 1).End(xlUp)
End With
End Function
LinkBack URL
About LinkBacks
Register To Reply
Bookmarks