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?
 

Some videos you may like

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,560
Office Version
  1. 2010
Platform
  1. Windows
The way I would do that is to have one timer and then use an index put the results in k8 and j8 or k16 and j16, the index is set according to which start or stop button is pressed. This will make any interaction between the two stated easy to handle. So you only have one of each of your subroutines.
 

Anton1999

New Member
Joined
Aug 5, 2020
Messages
25
Office Version
  1. 2013
Platform
  1. Windows
The way I would do that is to have one timer and then use an index put the results in k8 and j8 or k16 and j16, the index is set according to which start or stop button is pressed. This will make any interaction between the two stated easy to handle. So you only have one of each of your subroutines.
The thing is this sheet actually consists of 10 different timesheet entries which change on a daily basis as it is used in an accounting practice. And then these time entries are pulled to another application. The index I tried, but the type of tasks recorded literally changes everyday. And are paused/continued as the day progresses. So I cannot do anything else except use different buttons with different cells.
 

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,560
Office Version
  1. 2010
Platform
  1. Windows
All the more reason to use one timer
 

Anton1999

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

ADVERTISEMENT

I attached a screenshot. The tasks change daily and are done throughout the day, the index would only allow one task at a time to be paused and continued. Whereas that in practice isn't possible. When we do say risk assessment and a client walks in the risk assessment is paused and the meeting is started. Meeting ends and is paused and risk assessment is started again. In the end the total amount of time is timed throughout the day.
 

Attachments

  • Screenshot.png
    Screenshot.png
    19.3 KB · Views: 5

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,560
Office Version
  1. 2010
Platform
  1. Windows
So from what I understand you have a number of tasks, ( 10 shown in you current list but presumably it could be any number)
the user can only work on one task at once, so when they start working on a task they click the button for that task,
when they stop working on that task they click the stop or pause button for that task,
If the user clicks the start button for a task which is not the task they are currently working on then you want a warning message to pop up possibly asking the user what they want to do, or something
If this fits your requirement, then system analysis means you should only have one timer, this is because the user can only "spend" time on one task at once. the user can swap tasks as often as he likes.
Do you have requirement that there MUST be a task active at all times? If this is the case you don't really need the stop and pause buttons. This might be the case if one of your tasks is "personal breaks, e.g. coffee, lunch etc.
The key to doing this is separating the logic for the system from the recording of the times
 

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,560
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

Here is some code which starts and stops timers for any number of tasks ( I have currently created start and stop routines for two tasks) It uses an index system and show which task is active (column J) what time it started ( Col K) and how long has currently been spent on the task in column L) when the task is stopped it adds the current time spent into column E . Note I used a 10 seconds update rather than 1 second update because updating every seconds slows the workbook down a bit. To use it, run starttask1 routine and then stoptask1 routine, then try the same with starttask2 and you will see it puts the information on a different line., if you run starttask1 while timer2 is running you get a message box pop up. This is all much simpler to deal with that the way you are trying to do it.
VBA Code:
Public stoptimer
Public taskind As Long
Sub starttask1()
If taskind > 0 Then
MsgBox " Task " & taskind & " Is active, please stop that task"
Else
taskind = 2
Call initialise
End If
End Sub
Sub stoptask1()
taskind = 2
Call stoptask
End Sub
Sub starttask2()
If taskind > 0 Then
MsgBox " Task " & taskind & " Is active, please stop that task"
Else
taskind = 3
Call initialise
End If
End Sub
Sub stoptask2()
taskind = 3
Call stoptask
End Sub
Sub initialise()
With Worksheets("sheet1")

.Cells(taskind, 10) = "Timer On"
.Cells(taskind, 11) = TimeValue(Now)
.Cells(taskind, 12) = ""
  End With
  Application.OnTime Now + TimeValue("00:00:10"), "increment"
  stoptimer = False
End Sub
Sub increment()
With Worksheets("sheet1")
If Not (stoptimer) Then
.Cells(taskind, 12) = (TimeValue(Now) - .Cells(taskind, 11)) * 24 * 60
  Application.OnTime Now + TimeValue("00:00:10"), "increment"
End If
End With

End Sub
Sub stoptask()
With Worksheets("sheet1")
.Cells(taskind, 5) = .Cells(taskind, 5) + (TimeValue(Now) - .Cells(taskind, 11)) * 24 * 60
.Cells(taskind, 10) = ""
.Cells(taskind, 11) = ""
.Cells(taskind, 12) = ""
End With
taskind = 0
stoptimer = True
End Sub
I haven't dealt with pausing a timer because I wasn't quite clear about the requirements, what is the difference between pausing and stopping a timer, do you expect to see the value which I have put in column L remaining there ?
 

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,560
Office Version
  1. 2010
Platform
  1. Windows
I have just had more thoughts on pausing a timer, what about the following: when a timer is "paused" I could write "Paused" in column J, and leave the current time expended in column L, then when Starttimer is called again, if the timer is paused, I just continue updating the value in column L, rather than starting from zero. If a timer is paused any other task can be started.
 

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,560
Office Version
  1. 2010
Platform
  1. Windows
try this code which includes the pause functions:
VBA Code:
   Public stoptimer
    Public taskind As Long
    Sub starttask1()
    If taskind > 0 Then
    MsgBox " Task " & taskind & " Is active, please stop that task"
    Else
    taskind = 2
    Call initialise
    End If
    End Sub
    Sub stoptask1()
    taskind = 2
    Call stoptask
    End Sub
    Sub starttask2()
    If taskind > 0 Then
    MsgBox " Task " & taskind & " Is active, please stop that task"
    Else
    taskind = 3
    Call initialise
    End If
    End Sub
    Sub stoptask2()
    taskind = 3
    Call stoptask
    End Sub
    Sub initialise()
    With Worksheets("sheet1")
     If Not (.Cells(taskind, 10) = "Paused") Then
          .Cells(taskind, 12) = ""
     End If
     .Cells(taskind, 10) = "Timer On"
     .Cells(taskind, 11) = TimeValue(Now)
     .Cells(taskind, 13) = TimeValue(Now)
      End With
      Application.OnTime Now + TimeValue("00:00:10"), "increment"
      stoptimer = False
    End Sub
    Sub increment()
    With Worksheets("sheet1")
    If Not (stoptimer) Then
     .Cells(taskind, 12) = .Cells(taskind, 12) + (TimeValue(Now) - .Cells(taskind, 13)) * 24 * 60
     .Cells(taskind, 13) = TimeValue(Now)
      Application.OnTime Now + TimeValue("00:00:10"), "increment"
    End If
    End With
    
    End Sub
    Sub stoptask()
    With Worksheets("sheet1")
     .Cells(taskind, 5) = .Cells(taskind, 5) + .Cells(taskind, 12) + (TimeValue(Now) - .Cells(taskind, 13)) * 24 * 60
     .Cells(taskind, 10) = ""
     .Cells(taskind, 11) = ""
     .Cells(taskind, 12) = ""
     .Cells(taskind, 13) = ""
     End With
    taskind = 0
    stoptimer = True
    End Sub
    
    Sub pausetask()
    With Worksheets("sheet1")
     .Cells(taskind, 10) = "Paused"
     End With
    taskind = 0
    stoptimer = True
    End Sub
 

Anton1999

New Member
Joined
Aug 5, 2020
Messages
25
Office Version
  1. 2013
Platform
  1. Windows
I REALLY like the code and gosh I ran it today, it would have worked if my boss were not so hard headed. I attached a screenshot of my Main sheet where the time is recorded.

At the end of the day comments and notes are made in those blocks relating to all the different tasks. These are used as supporting evidence. That is why I have to keep all the buttons and such as is.
 

Attachments

  • Screenshot Main sheet.jpg
    Screenshot Main sheet.jpg
    96.4 KB · Views: 3

Watch MrExcel Video

Forum statistics

Threads
1,118,813
Messages
5,574,483
Members
412,596
Latest member
nickthebizz
Top