Two timers alert message

Anton1999

New Member
Joined
Aug 5, 2020
Messages
25
Office Version
  1. 2013
Platform
  1. Windows
Good evening everyone,

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?
 

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,548
Office Version
  1. 2010
Platform
  1. Windows
So , from your comments , I guess the functionality is correct, you just want to move the display around which is very easy.
Looking at your screen shots it looks like you need to step 6 rows between each task.
I have currently got displays of
1: current Status ( blank, Timer on and paused) col J
2: Start Time Col K
3: Time spent on Task Col L
4: Last update time Col M
5: Total Time spent on this task Col E
Which columns and rows do you want these in for each task.
Also What functionality do you want for the "reset" button"
 

Some videos you may like

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.

Watch MrExcel Video

Forum statistics

Threads
1,118,293
Messages
5,571,365
Members
412,384
Latest member
Zaw Min
Top