Hello dancing-shadow,
The attached workbook will automatically check the reports once the workbook is opened. Checks are made every minute. Any report falling within the dates and matching the current time are listed in a dialog box.
Public RemindersOn As Boolean
Sub ReportReminder()
Dim BegDate As Date
Dim Cell As Range
Dim EndDate As Date
Dim EndRow As Long
Dim Msg As String
Dim Owner As String
Dim Project As String
Dim Rng As Range
Dim Row As Long
Dim Wks As Worksheet
Set Wks = Sheet1
Set Rng = Wks.Range("A4:D4")
EndRow = Wks.Cells(Rows.Count, Rng.Column).End(xlUp).Row
If EndRow < Rng.Row Then Exit Sub
Set Rng = Rng.Resize(RowSize:=EndRow - Rng.Row + 1)
For Each Cell In Rng.Columns("D:D").Cells
If Not IsEmpty(Cell) Then
If Cell = TimeSerial(Hour(Now), Minute(Now), 0) Then
Row = Cell.Row
If Date >= Wks.Cells(Row, "BS") And Date <= Wks.Cells(Row, "BT") Then
If Msg = "" Then Msg = "The following Projects are Due..." & vbCrLf & vbCrLf
Row = Cell.Row
Msg = Msg & "Project: " & Wks.Cells(Row, "A") & vbCrLf
Msg = Msg & "Owner: " & Wks.Cells(Row, "B") & vbCrLf
Msg = Msg & vbCrLf
End If
End If
End If
Next Cell
If Msg <> "" Then MsgBox Msg, vbOKOnly, "Reminder " & Format(Now(), "h:mm AM/PM")
Call StartReminders
End Sub
Sub StartReminders()
If RemindersOn = True Then Application.OnTime Now() + TimeSerial(0, 1, 0), "ReportReminder", , True
End Sub
Sub StopReminders()
RemindersOn = False
End Sub
Bookmarks