Calendar pop up reminder

[CuriousGeorg]

Good afternoon,

I'm looking for a simple query. I need a calendar that when a particular item is due within the next 7 days a pop up appears showing what is due and what dates.

This can be as simple as a list of:
column a: What Due
column b: Date Due

and the pop up just shows both. (ideally the pop up is a UF)..

unfortunately, conditional formatting isnt worth it here and i cant use outlook or add ins.


if i could have a calendar that has a similar outcome then great.


(its basically going to be a holiday tracker that pops up on open who is off in the next 7 days)


Any help would be great.

[Bob Phillips]

Public Function DueTasks()
Dim msg As String
Dim lastrow As Long
Dim i As Long

    With Worksheets("Sheet2")
    
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 2 To lastrow
            
            If .Cells(i, "B").Value >= Date And .Cells(i, "B").Value < Date + 7 Then
            
                msg = msg & vbTab & .Cells(i, "A").Value & " due on " & Format(.Cells(i, "B").Value, "ddd dd-mmm") & vbNewLine
            End If
        Next i
        
        If msg <> "" Then
        
            MsgBox "Items due in next 7 days:" & vbNewLine & msg, vbOKOnly, "Due Tasks"
        Else
        
            MsgBox "Nothing due in next 7 days", vbOKOnly, "Due Tasks"
        End If
    End With
End Function

[CuriousGeorg]

ok that works nice.

I just need to have it pop up as soon as it loads.. Sweet.

[Bob Phillips]

Put it in the Workbook_Open event.

[CuriousGeorg]

xld Thanks for this it works a treat I just have a slight problem..

If there is a date due it produces the pop up 12 times..

Code im using is

Private Sub workbook_open()   Dim msg As String
    Dim lastrow As Long
    Dim i As Long
     
    With Worksheets("Jan")
         
        lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
        For i = 2 To lastrow
             
            If .Cells(i, "A").Value >= Date And .Cells(i, "A").Value < Date + 7 Then
                 
                msg = msg & vbTab & .Cells(i, "B").Value & "  off on  " & Format(.Cells(i, "A").Value, "ddd dd mmm") & vbNewLine
            End If
        Next i
         
        If msg <> "" Then
             
            MsgBox "Leaders off within the next 7 days:" & vbNewLine & vbNewLine & msg, vbOKOnly, "Who"
        'Else
             
            'MsgBox "No-one off within next 7 days", vbOKOnly, "Leader Absence"
        End If
    End With
    With Worksheets("Feb")
         
        lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
        For i = 2 To lastrow
             
            If .Cells(i, "A").Value >= Date And .Cells(i, "A").Value < Date + 7 Then
                 
                msg = msg & vbTab & .Cells(i, "B").Value & "  off on  " & Format(.Cells(i, "A").Value, "ddd dd mmm") & vbNewLine
            End If
        Next i
         
        If msg <> "" Then
             
            MsgBox "Leaders off within the next 7 days:" & vbNewLine & vbNewLine & msg, vbOKOnly, "Who"
        'Else
             
            'MsgBox "No-one off within next 7 days", vbOKOnly, "Leader Absence"
        End If
    End With
    With Worksheets("Mar")
         
        lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
        For i = 2 To lastrow
             
            If .Cells(i, "A").Value >= Date And .Cells(i, "A").Value < Date + 7 Then
                 
                msg = msg & vbTab & .Cells(i, "B").Value & "  off on  " & Format(.Cells(i, "A").Value, "ddd dd mmm") & vbNewLine
            End If
        Next i
         
        If msg <> "" Then
             
            MsgBox "Leaders off within the next 7 days:" & vbNewLine & vbNewLine & msg, vbOKOnly, "Who"
        'Else
             
            'MsgBox "No-one off within next 7 days", vbOKOnly, "Leader Absence"
        End If
    End With
        With Worksheets("Apr")
         
        lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
        For i = 2 To lastrow
             
            If .Cells(i, "A").Value >= Date And .Cells(i, "A").Value < Date + 7 Then
                 
                msg = msg & vbTab & .Cells(i, "B").Value & "  off on  " & Format(.Cells(i, "A").Value, "ddd dd mmm") & vbNewLine
            End If
        Next i
         
        If msg <> "" Then
             
            MsgBox "Leaders off within the next 7 days:" & vbNewLine & vbNewLine & msg, vbOKOnly, "Who"
        'Else
             
            'MsgBox "No-one off within next 7 days", vbOKOnly, "Leader Absence"
        End If
    End With

    End Sub

ETC ETC

So, whilst it picks up the correct month. It just shows the pop up several times and i'm not sure why.. can you shed any light.

[Bob Phillips]

SO you have a separate sheet for each month? Whilst I wouldn't do that, it shouldn't cause a problem . But you also should not check each sheet that is wasteful, the next 7 days can only be in this month and next, so you should only check those. I would also keep appending to one message, not throw out two at month-end.

All of this helps you not a jot, and I am afraid I don't see anything in the code to cause it. I just tried it and only got one message. Yiu don't have all dates in each sheet do you?

[CuriousGeorg]

Thereason the months are on separate sheets is there is plenty more as a planner in the sheet and it's the best way to organise everything. The dates "off" for January are in January's sheet. February's in February etc. I guess I could have a summary page of all the dates and get the,code to read from that. Perhaps it's just me. Thanks anyway

[Bob Phillips]

I know what it is, you need to initialise msg before every month test, just use

msg = ""

[CuriousGeorg]

Sorry confused where to put that. I ha've msg in the code. Not at a computer to play around but I can't see where it goes by eyeballing. Sorry if I sound an idiot..


Edit.. I see it