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?
 
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"
 
Upvote 0

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.

Forum statistics

Threads
1,214,409
Messages
6,119,339
Members
448,888
Latest member
Arle8907

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top