VBA - Pop alert for list of dates

Some videos you may like

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.

PT_ANCF

New Member
Joined
Mar 18, 2019
Messages
13
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

Well-known Member
Joined
Jul 5, 2014
Messages
16,718
Office Version
2013
Platform
Windows
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
 
Last edited:

PT_ANCF

New Member
Joined
Mar 18, 2019
Messages
13
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

Well-known Member
Joined
Jul 5, 2014
Messages
16,718
Office Version
2013
Platform
Windows
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

Code:
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

Well-known Member
Joined
Jul 5, 2014
Messages
16,718
Office Version
2013
Platform
Windows
Here is another one with a nicer looking Shape.
Assuming your version of Excel has this shape

Us Excel Geeks like making new things:
Code:
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
 

Forum statistics

Threads
1,089,210
Messages
5,406,868
Members
403,109
Latest member
gamer527

This Week's Hot Topics

Top