Reminder on Open

[lapta301]

Dear All

Could I trouble you for some assistance with a request that someone has put to me.

On a worksheet named Control in cells A1 to A5 there are dates with a descriptive piece of text in cells B1 to B5. The range is sorted by the dates in ascending order.

What they would like is that each time the workbook is opened a messagebox shows the number of days from now until the next up coming entry including today with the descriptive text.

So if the next upcoming date in the range A1 to A5 is 25th July 2011 then the following is shown.

25th July 2011
Budget Report
3 days

or if there is an entry today then

22nd July 2011
Budget Report
Due Today

and finally if there are no entries for today or in the future then just show

There are no reminders


I hope that this makes sense.

As ever any help you can provide is most appreciated.

 

[GTO]

Certainly doable. Could you tack in some sample data?

 

[lapta301]

GTO

All I can show is as below

22/7/11 Budget Report
25/7/11 Authorisation
01/8/11 Publish

So today being the 22nd it would show

22nd July 2011
Budget Report
Due Today

Then on the 23rd July

25th July 2011
Authorisation
2 days

On the 24th July

25th July 2011
Authorisation
1 day

and likewise for the 1st August entry after the 25th and then finally after the 1st August
There are no reminders.

 

[GTO]

Maybe:

Private Sub Workbook_Open()
Dim rngCell As Range
Dim bolFound As Boolean
Dim i As Long
    
    For i = 1 To 5
        If ThisWorkbook.Worksheets("mySheet").Cells(i, 1).Value >= Date Then
            
            MsgBox Format(ThisWorkbook.Worksheets("mySheet").Cells(i, 1).Value, "dd mmmm yyyy") & vbCrLf & _
                   ThisWorkbook.Worksheets("mySheet").Cells(i, 2).Text & vbCrLf & _
                   IIf(ThisWorkbook.Worksheets("mySheet").Cells(i, 1).Value > Date, _
                       ThisWorkbook.Worksheets("mySheet").Cells(i, 1).Value - Date & " day(s)", _
                       "Today"), _
                   vbInformation, vbNullString
            Exit For
        End If
    Next
End Sub

 

[lapta301]

GTO

That works a treat other than if there are no reminders for today and the future there needs to be a message to say that there are no reminders.

Many thanks

 

[lapta301]

GTO

Sorry to be a pain but they have come back with 2 further requests.

Instead of using A1 to B5 can a range name be used which would enable them to extend or reduce the number of rows.

The number of days left calculation should only be the working week ie Monday to Friday

My sincere apologies for adding these extras.

 

[GTO]

GTO

That works a treat other than if there are no reminders for today and the future there needs to be a message to say that there are no reminders.

Many thanks

ACK! I forgot that bit. We can set a flag and check it.

GTO

Sorry to be a pain but they have come back with 2 further requests.

Instead of using A1 to B5 can a range name be used which would enable them to extend or reduce the number of rows.

The number of days left calculation should only be the working week ie Monday to Friday

My sincere apologies for adding these extras.

Please note that we are only using the first column as the range.

Not well checked, but try:

Option Explicit
    
Private Sub Workbook_Open()
Dim wks             As Worksheet
Dim rngNamed        As Range
Dim bolFound        As Boolean
Dim lFirstRow       As Long
Dim lRowCount       As Long
Dim lColumnNumber   As Long
Dim i               As Long
Dim lDayVal         As Long
Dim lDaysThatCount  As Long
    
    '// Set a reference to the first column, the one with the dates...                  //
    Set wks = ThisWorkbook.Worksheets("mySheet")
    
    '// Prevent an error from stopping us.  Reset immediately afterwards.               //
    On Error Resume Next
    Set rngNamed = wks.Range("myRange")
    On Error GoTo 0
    
    '// IF setting rngNamed failed, it will refer to Nothing.                           //
    If rngNamed Is Nothing Then
        MsgBox "You killed ""myRange"" - I can no longer work...", vbInformation, vbNullString
    Else
        lFirstRow = rngNamed.Row
        lRowCount = rngNamed.Rows.Count
        lColumnNumber = rngNamed.Column
        
        For i = lFirstRow To lFirstRow + lRowCount - 1
        
            If ThisWorkbook.Worksheets("mySheet").Cells(i, lColumnNumber).Value >= Date Then
                
                For lDayVal = Date + 1 To ThisWorkbook.Worksheets("mySheet").Cells(i, lColumnNumber).Value
                    Select Case Weekday(lDayVal, vbMonday)
                    Case 1 To 5: lDaysThatCount = lDaysThatCount + 1
                    End Select
                Next
                
                MsgBox Format(ThisWorkbook.Worksheets("mySheet").Cells(i, lColumnNumber).Value, "dd mmmm yyyy") & vbCrLf & _
                       ThisWorkbook.Worksheets("mySheet").Cells(i, lColumnNumber + 1).Text & vbCrLf & _
                       IIf(lDaysThatCount > 0, _
                           lDaysThatCount & " day(s)", _
                           "Today"), _
                       vbInformation, vbNullString
    
                bolFound = True
                Exit For
            End If
        Next
        
        If Not bolFound Then
            MsgBox "A reminder to remind you that there is nothing to be reminded of...", 0, vbNullString
        End If
    End If
End Sub

Hope that helps,

Mark

 

[lapta301]

Mark

That's very good thank you so much.

One last question, can we put a heading on the message box, something imaginative like REMINDER.

Many thanks


Steve

 

[GTO]

You can use the titlebar's caption for this.

 

[lapta301]

GTO

Sorry to sound dense but I have had a play about with your suggestion but cannot seem to find the correct place to insert it.

Could I trouble you again for your help with what I am sure is simple and I will groan when I know how.

Regards


Steve