Good evening everyone,
If anyone can assist me please.
I have 2 Start, reset, pause/continue, stop buttons which needs to stay separate. But for the life of me I cannot figure out how to
display an error message when one timer is busy and another should not. Only one timer van be used or be active at a time.
As one cannot work on two tasks as once. The goal is to not have both timers active at once. And an error message should be displayed when
the user accidentally starts both timers at once.
Can someone please assist me?
If anyone can assist me please.
VBA Code:
Sub Start_Timer()
Application.OnTime Now + TimeValue("00:00:01"), "IncreamentTimer"
End Sub
Sub IncreamentTimer()
If ThisWorkbook.Sheets("Sheet1").Range("K9").Value = "" Then ThisWorkbook.Sheets("Sheet1").Range("K9").Value = TimeValue(Now)
If ThisWorkbook.Sheets("Sheet1").Range("K8").Value = "" Then ThisWorkbook.Sheets("Sheet1").Range("K8").Value = TimeValue(Now)
ThisWorkbook.Sheets("Sheet1").Range("K8").Value = ThisWorkbook.Sheets("Sheet1").Range("K8").Value + TimeValue("00:00:01")
If ThisWorkbook.Sheets("Sheet1").Range("J8").Value = "" Then ThisWorkbook.Sheets("Sheet1").Range("J8").Value = "Timer ON"
ThisWorkbook.Sheets("Sheet1").Range("J9").Value = "Timer Start Time"
ThisWorkbook.Sheets("Sheet1").Range("J8").Font.Color = vbGreen
sTimer = True
Start_Timer
End Sub
Sub PauseResume_Timer()
If ThisWorkbook.Sheets("Sheet1").Range("K9").Value <> "" Then
If sTimer = True Then
sTimer = False
Application.OnTime Now + TimeValue("00:00:01"), "IncreamentTimer", schedule:=False
ThisWorkbook.Sheets("Sheet1").Range("J8").Value = "Timer Paused"
ThisWorkbook.Sheets("Sheet1").Range("J8").Font.Color = vbRed
Else
Application.OnTime Now + TimeValue("00:00:01"), "IncreamentTimer"
ThisWorkbook.Sheets("Sheet1").Range("J8").Value = "Timer Resumed"
ThisWorkbook.Sheets("Sheet1").Range("J8").Font.Color = vbGreen
End If
Else
MsgBox "You can only click Pause/Resume button when Timer is On.", vbExclamation, "Timer Off!"
End If
End Sub
Sub Stop_Timer()
With ThisWorkbook
Set wsSheet1 = .Worksheets("Sheet1")
Set wsTimeSummary = .Worksheets("Time Summary")
End With
On Error Resume Next
Application.OnTime Now + TimeValue("00:00:01"), "IncreamentTimer", schedule:=False
If Err = 0 Then
With wsSheet1
.Range("L9").Value = Format(.Range("K8").Value - .Range("K9").Value, "hh:mm:ss")
.Range("J8").Value = "Timer OFF"
.Range("J8").Font.Color = vbBlack
End With
With wsTimeSummary
.Range("D12").Copy
.Range("E12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
Application.CutCopyMode = False
Else
MsgBox "Timer Is currently OFF.", vbExclamation, "Timer Is OFF!"
End If
End Sub
Sub Reset_Timer()
ThisWorkbook.Sheets("Sheet1").Range("K8").Value = ""
ThisWorkbook.Sheets("Sheet1").Range("K9").Value = ""
ThisWorkbook.Sheets("Sheet1").Range("J8").Value = ""
ThisWorkbook.Sheets("Sheet1").Range("J9").Value = ""
ThisWorkbook.Sheets("Sheet1").Range("L9").Value = ""
End Sub
'=================================================================================================================================
'=================================================================================================================================
Sub Start_Timer2()
Application.OnTime Now + TimeValue("00:00:01"), "IncreamentTimer2"
End Sub
Sub IncreamentTimer2()
If ThisWorkbook.Sheets("Sheet1").Range("K17").Value = "" Then ThisWorkbook.Sheets("Sheet1").Range("K17").Value = TimeValue(Now)
If ThisWorkbook.Sheets("Sheet1").Range("K16").Value = "" Then ThisWorkbook.Sheets("Sheet1").Range("K16").Value = TimeValue(Now)
ThisWorkbook.Sheets("Sheet1").Range("K16").Value = ThisWorkbook.Sheets("Sheet1").Range("K16").Value + TimeValue("00:00:01")
If ThisWorkbook.Sheets("Sheet1").Range("J16").Value = "" Then ThisWorkbook.Sheets("Sheet1").Range("J16").Value = "Timer ON"
ThisWorkbook.Sheets("Sheet1").Range("J17").Value = "Timer Start Time"
ThisWorkbook.Sheets("Sheet1").Range("J16").Font.Color = vbGreen
sTimer2 = True
Start_Timer2
End Sub
Sub PauseResume_Timer2()
If ThisWorkbook.Sheets("Sheet1").Range("K17").Value <> "" Then
If sTimer2 = True Then
sTimer2 = False
Application.OnTime Now + TimeValue("00:00:01"), "IncreamentTimer2", schedule:=False
ThisWorkbook.Sheets("Sheet1").Range("J16").Value = "Timer Paused"
ThisWorkbook.Sheets("Sheet1").Range("J16").Font.Color = vbRed
Else
Application.OnTime Now + TimeValue("00:00:01"), "IncreamentTimer2"
ThisWorkbook.Sheets("Sheet1").Range("J16").Value = "Timer Resumed"
ThisWorkbook.Sheets("Sheet1").Range("J16").Font.Color = vbGreen
End If
Else
MsgBox "You can only click Pause/Resume button when Timer is On.", vbExclamation, "Timer Off!"
End If
End Sub
Sub Stop_Timer2()
With ThisWorkbook
Set wsSheet1 = .Worksheets("Sheet1")
Set wsTimeSummary = .Worksheets("Time Summary")
End With
On Error Resume Next
Application.OnTime Now + TimeValue("00:00:01"), "IncreamentTimer2", schedule:=False
If Err = 0 Then
With wsSheet1
.Range("L17").Value = Format(.Range("K16").Value - .Range("K17").Value, "hh:mm:ss")
.Range("J16").Value = "Timer OFF"
.Range("J17").Font.Color = vbBlack
End With
With wsTimeSummary
.Range("D13").Copy
.Range("E13").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
Application.CutCopyMode = False
Else
MsgBox "Timer Is currently OFF.", vbExclamation, "Timer Is OFF!"
End If
End Sub
Sub Reset_Timer2()
ThisWorkbook.Sheets("Sheet1").Range("K16").Value = ""
ThisWorkbook.Sheets("Sheet1").Range("K17").Value = ""
ThisWorkbook.Sheets("Sheet1").Range("J16").Value = ""
ThisWorkbook.Sheets("Sheet1").Range("J17").Value = ""
ThisWorkbook.Sheets("Sheet1").Range("L17").Value = ""
End Sub
I have 2 Start, reset, pause/continue, stop buttons which needs to stay separate. But for the life of me I cannot figure out how to
display an error message when one timer is busy and another should not. Only one timer van be used or be active at a time.
As one cannot work on two tasks as once. The goal is to not have both timers active at once. And an error message should be displayed when
the user accidentally starts both timers at once.
Can someone please assist me?