Selected Answer
Jimz
In the revised sheet attached, all the cells in A4:F12 have data validation so only times (in the format 00:00:00) can be entered- you had mixed fomats - so that they can be compared with the VBA variable Time (= local system time). Formatting has been changed to show seconds too (although that isn't necessary for the code to work).
You'll see B1 is the current time- that will start to count when the green "Start timer..." button is pressed. That calls up this macro (with comments):
Sub StartTimer()
InitAlrms 'clear formatting and load alarms
SetTime ' start the timer
End Sub
which first calls this macro:
Sub InitAlrms()
With Range("A3").CurrentRegion
ReDim Alrms(1 To .Rows.Count, 1 To .Columns.Count)
For m = 1 To UBound(Alrms, 1)
For n = 1 To UBound(Alrms, 2)
With Range("A3").Offset(m - 1, n - 1)
Alrms(m, n) = .Value
If m > 1 Then .Interior.Color = 16777215
End With
Next n
Next m
End With
End Sub
which loads the alarm times (currently in B4:F12) plus the column headings into an array so it can be checked quickly (every second).Note you could add another row or column (to get even more alarms) and the macro will adjust but you need to bear in mind the red warning (currently in A14).
Then this macro is called which starts the timer- it updates the time in cell B1 and calls itself again (every second). Importantly it first calls the macro in bold:
Sub SetTime()
CheckAlrms 'see if alarms need displaying
SchedRecalc = Now + TimeValue("00:00:01")
Application.OnTime SchedRecalc, "SetTime" 'retrigger
Sheet1.Range("B1").Value = Time 'update time
End Sub
That's this macro below, which runs through the array (which was loaded before) and uses the test (in bold, over three split lines) to see if there's a valid time in the array cells and if it/they match the current sytsem time (or within 2 seconds of it). If so it calls in
InitAlrms macro (to clear any cells set as red and) to made matching cells red. It also collects the associated column heading and gives a beep plus message of the alarm (or several alarms) which now show red instead whatever was set to red before (your old scheduled tasks):
Sub CheckAlrms()
Dim Mess As String, m As Long, n As Long, NewAlrm As Boolean
NewAlrm = False
For m = 2 To UBound(Alrms, 1)
For n = 1 To UBound(Alrms, 2)
With Range("A3").Offset(m - 1, n - 1)
If IsEmpty(Alrms(m, n)) = False And _
Time >= Alrms(m, n) And _
Time < (Alrms(m, n) + TimeValue("00:00:02")) Then
If NewAlrm = False Then InitAlrms
NewAlrm = True ' set flag
Mess = Mess & "Alarm: " & Alrms(1, n) & " from " & CDate(.Value) & vbLf
.Interior.Color = vbRed
End If
End With
Next n
Next m
If Mess <> "" Then
Beep
MsgBox Mess ' comment this out if alarms are <1 min apart
End If
End Sub
Note that the message box needs to be cleared (by clicking Ok) but you could comment that line out if you just rely on the red cells (which will indicate the latest task to be done).
The pinky button "Stop timer..." will clear B1 since it calls this macro:
Sub Reset()
Call Disable 'stop timer
Sheet1.Range("B1").Value = "" 'clear time
End Sub
The called
Disable macro just stops the
SetTime macro (see in file).
This should allow you to have lots of alarms in a day and see which task you should be working on. You can play around in cells F9:F12 to see how the messages and cell shading works (e.g. when you have two with the exact same time) if you want to leave your existing times unaffected. Use the Start... button when you change values so the array is re-loaded (that could be done automatically but I haven't done that).
Note that you'll need this file to be running (/visible) for it to update/ you to get alerts
Hope this fixes your problem.If so, kindly change your question title to "Multiple/ many daily alarms to alert work tasks/ priority" (which better describes the solution, for the guidance of other users).
