Time Stamp

[jetoon_sheth]

Hello,
I am looking for a function that is related to Time Stamp.

This is what i want to do. We use Excel Sheet which has a time by which the production should be done. What i want to do is, set up a function/macro that will alert my production planner ETA is nearby. What would be also cool is if i can do conditional formatting. Ex: if my ETA is 10:30, at 10:15 the cell will turn Orange, then by 10:20, cell will turn red.

However i am assuming the Excel has to take Computer system time. Please help. This is will be very beneficial for my company.

Thank You

 

[pbornemeier]

Add this code to a standard module.
On Sheet1 for each ETA (time) in column A the TTG (time to go) will be generated in column B. Use conditional formatting with this column to trigger a color change on the ETA and TTG as you desire. It will update every 15 seconds.

Run ETACheck to start the updates and StopTimer to end it.

Option Explicit

'Basic idea taken from:
'from http://www.cpearson.com/excel/OnTime.aspx

Sub ETACheck()
    Dim lLastETARow As Long
    Dim lX As Long
    Dim dblValue As Double
    
    With Worksheets("Sheet1")
        .Range("A1").Value = "ETA"
        .Range("B1").Value = "TTG" ' (time to go)
        .Range("C1").Value = "Last Checked"
        .Cells(1, 4) = Format(Now(), "hh:mm:ss")
        lLastETARow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For lX = 2 To lLastETARow
            With .Cells(lX, 2)
                dblValue = Worksheets("Sheet1").Cells(lX, 1).Value - (CDbl(Now() - Int(Date)))
                If dblValue <= 0 Then
                    .Value = "LATE"
                Else
                    .Value = Worksheets("Sheet1").Cells(lX, 1).Value - (CDbl(Now() - Int(Date)))
                    .NumberFormat = "hh:mm:ss"
                End If
            End With
        Next
    End With
    StartTimer  ' Reschedule the procedure
    
End Sub

Sub StartTimer()
    Dim RunWhen As Date
    RunWhen = Now + TimeSerial(0, 0, 15) 'Run every 15 seconds
    Application.OnTime EarliestTime:=RunWhen, Procedure:="ETACheck", _
        Schedule:=True
End Sub

Sub StopTimer()
    On Error Resume Next
    Dim RunWhen As Date
    
    Application.OnTime EarliestTime:=RunWhen, Procedure:="ETACheck", _
        Schedule:=False
End Sub