VBA - Pop alert for list of dates

[PT_ANCF]

Hello all,


First of all, I tried to find a similar thread but without much success (as I'm new) for my question. So sorry, if there is already a similar thread and if yes and you have it, just point me to the right direction. Thank you.


So I have a list of client contracts and I would like to have a pop-alert running through VBA that would give me an alert. For example:

In this case, I would like for a pop up tab to appear with the clients that, in column E, are -3 months from the End date (column D) with a message like "Renewal meeting with Client(s) x and y" e.g.


I have the idea that it's possible as I've seen it for one single cell but I would like the alert to catch all the contracts that are -3months. Is this possible?


Thank you so much for the aid.


Best regards,
PT_ANCF

 

[PT_ANCF]

Again, seems to be working fine.

Thank you very much

 

[My Aswer Is This]

Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.

Again, seems to be working fine.

Thank you very much

 

[PT_ANCF]

I was trying to change the starting range for D19 instead of D1 for the end date but I'm messing to much with the code :S (really waiting for my vba classes).

Any suggestion? Same idea just starting to read the End date (column D) in another row (in this case "19"),

Thanks again

 

[My Aswer Is This]

My script did just what your image showed.
Your image seems to say start looking on D2

But if you want to start on D19 change this line of code:

For i = Lastrow To 2 Step -1

To:

For i = Lastrow To 19 Step -1

 

[PT_ANCF]

Yes, I just added some extra lines to my document.

Thank you for the patience and explication.

This helped me a lot to finish a contract project I had.

 

[My Aswer Is This]

In case your still here:

I always prefer to use a TextBox to display Data on the screen instead of Message Box.
This way the data can stay visible when script ends.

Try this new script:

A Shape TextBox will have the Data you want:

To delete the shape after viewing just press Delete Key if you still have shape selected.
Or select shape and then click delete key

Sub Date_New()
'Modified  3/20/2019  8:59:40 PM  EDT
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim n As String
Dim nn As String
Lastrow = Cells(Rows.Count, "D").End(xlUp).Row
For i = Lastrow To 19 Step -1
    
    If Cells(i, 4).Value <= Date + 90 And Cells(i, "I").Value <> "X" Then
            n = vbNewLine & Cells(i, 1).Value & n
    End If
Next
If n <> "" Then
    nn = "Renewal alert, clients:"
Else
nn = "None Found"
End If
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 435, 90.75, 177.75, 102).Select
    Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 0)
    Selection.Left = Range("G3").Left
    Selection.Top = Range("G3").Top
    ShapeName = Selection.Name
    
   
    With Selection.ShapeRange.TextFrame2
        .TextRange.Font.Size = 16
        .TextRange.ParagraphFormat.Alignment = msoAlignCenter
        .TextRange.Characters.Text = nn & vbNewLine & n
        .TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 255)
        .TextRange.Font.Bold = True
        .AutoSize = msoAutoSizeShapeToFitText
    End With
    
Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

Here is another one with a nicer looking Shape.
Assuming your version of Excel has this shape

Us Excel Geeks like making new things:

Sub Date_New()
'Modified  3/21/2019  4:43:51 AM  EDT
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim n As String
Dim nn As String
Lastrow = Cells(Rows.Count, "D").End(xlUp).Row
For i = Lastrow To 19 Step -1
    
    If Cells(i, 4).Value <= Date + 90 And Cells(i, "I").Value <> "X" Then
            n = vbNewLine & Cells(i, 1).Value & n
    End If
Next
If n <> "" Then
    nn = "Renewal alert, clients:"
Else
nn = "None Found"
End If
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 435, 90.75, 177.75, 102).Select
     Selection.Left = Range("G3").Left
    Selection.Top = Range("G3").Top
    ShapeName = Selection.Name
 
 Selection.ShapeRange.ShapeStyle = msoShapeStylePreset27
    With Selection.ShapeRange.ThreeD
        .BevelTopType = msoBevelSoftRound
        .BevelTopInset = 12
        .BevelTopDepth = 4
    End With
 
 
     With Selection.ShapeRange.TextFrame2
        .TextRange.Font.Size = 16
        .TextRange.ParagraphFormat.Alignment = msoAlignCenter
        .TextRange.Characters.Text = nn & n
        .TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
        .TextRange.Font.Bold = True
        .AutoSize = msoAutoSizeShapeToFitText
    End With
    
Application.ScreenUpdating = True
End Sub