Generate A Message Prompt

I am currently using the below to generate a message prompt. I have two questions that require assistance.

1. How can I furthur tweak it to show the value contains in the cell that correspond to the date?

For example in cell A2 contains date value; Cell B2 is the order number.

If the date in A2 matches today's date, the message prompt should carry Cell B2's value instead of B2 that is displayed as of below code.

2. Can I set the prompt date to be like 15 days after today's date?

Example: Today is 05/01. There will be a prompt if the date in cell A2 is 05/16.

Private Sub Workbook_Open()
Dim r As Range, ff As String, msg As String
With Sheets("Test")
Set r = .Columns(1).Find(Date, , xlFormulas, xlWhole)
If Not r Is Nothing Then
ff = r.Address
Do
msg = msg & vbLf & r.Address(0, 0)
Set r = .Columns(1).FindNext(r)
Loop Until ff = r.Address
End If
End With
MsgBox IIf(Len(msg), "Matches Found:" & msg, "No match found")
End Sub