Adding timer to adjacent cell

Question

Thank you for answering the previous question. Now I would like to start a timer to the corresponding cell of ticket arriving in Dashboard. During frequent update one of my cell update with a time of arrival of the ticket on the dashboard. As soon as the cell is updated with actual time I would like to run a timer to the corresponding cell. Once the timer crosses 15 min it should show in red colour. Not sure if this is possible. Please help me with this.

Answer 1

you can find info on timers here:

How do I show a running clock in Excel?

this link will show you how to run a sub (to start the timer) when a cell value changes

automatically execute an Excel macro on a cell change

you should create a variable to hold the time when the timer starts to allow you to determine when 15 mins have passed, then you can change the cell colour, eg.

Worksheets("Sheet1").Range("A1").Interior.Color = vbRed

Ok, I'll help you to create the code. You will have to edit it slightly for your specific sheet names and ranges. In this example I have a sheet named "timer", when the value in cell A1 changes a timer appears in cell B1 then after 15 seconds B1 turns red (I made it 15 seconds for testing, you can change to whatever you need). Also I turn off the timer once the 15 seconds have passed, you may want to leave it running and updating the cell.

You want to add this code to the sheet with the data that will change (in my case "timer"), repeat, don't put this code in a module, it has to be in the code of the sheet

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Target.Worksheet.Range("A1")) Is Nothing Then    
        StartTimer    
    End If    
End Sub

Then you want to create a module and add this code

Public Declare Function SetTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Public Declare Function KillTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long) As Long

Public TimerID As Long, TimerSeconds As Single, tim As Boolean
Dim Counter As Long
Dim StartTime As Date

Sub StartTimer()

    StartTime = Now()
    TimerSeconds = 1
    TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)

End Sub

Sub EndTimer()

    On Error Resume Next
    KillTimer 0&, TimerID

End Sub

Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, ByVal nIDEvent As Long, ByVal dwTimer As Long)

    Worksheets("timer").Range("B1").Value = Time

    If (Now - StartTime > TimeValue("00:00:15")) Then

        Worksheets("timer").Range("B1").Interior.Color = vbRed
        Worksheets("timer").Range("B1").Value = ""
        EndTimer

    End If

End Sub