MsgBox before date in specified cell

[inta251]

Worksheet 'REFUND_FORM', cell B10 formated as date.
Need VB scrip MsgBox. If in cell B10 date, let say 11/28/2010 message box will start popup as reminder 10 days before date in cell B10, when each time i will click on REFUND_FORM tab.

Sample:
B10 = 11/28/2010
MsgBox will start popup from 11/18/2010.
"10 days left before send your Refund Form for refund".

Thanks in advance.
inta251. Igor.

 

[Cloverken]

Select Worksheet "REFUND_FORM" then press ALT+F11 copy and paste the following code in blank pane on Right side.

Private Sub Worksheet_Activate()
On Error Resume Next
Dim d As Date
d = Range("B10").Value
    If d <= Date And d >= Date - 10 Then
        MsgBox ("10 days left before send your Refund Form for refund")
    End If
End Sub

 

[AlphaFrog]

Right-click on the REFUND_FORM tab and select View Code
Paste the code below in the VBA edit window

Private Sub Worksheet_Activate()

    Dim DaysRemaining As Long
    
    DaysRemaining = Range("B10") - Date
    
    Select Case DaysRemaining
        Case Is < 0: MsgBox "Past due for refund.", vbInformation, "Refund Reminder"
        Case Is = 0: MsgBox "Last day to send your Refund Form for refund.", vbInformation, "Refund Reminder"
        Case Is <= 10: MsgBox DaysRemaining & " days left before send your Refund Form for refund.", vbInformation, "Refund Reminder"
    End Select
    
End Sub

 

[inta251]

Thanks guys for reply!
Cloverken, for some reason your script not working.
AlphaFrog, your script perfect, but only problem, when cell B10 empty message still showup "Past due for refund."
You guys PRO!

Private Sub Worksheet_Activate()
Dim DaysRemaining As Long

DaysRemaining = Range("B10") - Date

Select Case DaysRemaining
Case Is < 0: MsgBox "Past due for Refund.", vbInformation, "Refund Reminder"
Case Is = 0: MsgBox "Last day to send your Refund Request for refund.", vbInformation, "Refund Reminder"
Case Is <= 10: MsgBox DaysRemaining & " days left before send your Refund Request for refund.", vbInformation, "Refund Reminder"
End Select

End Sub

 

[AlphaFrog]

Private Sub Worksheet_Activate()

    Dim DaysRemaining As Long
    
    [COLOR="Red"]If IsDate(Range("B10")) Then
[/COLOR]    
        DaysRemaining = Range("B10") - Date
        
        Select Case DaysRemaining
            Case Is < 0: MsgBox "Past due for refund.", vbInformation, "Refund Reminder"
            Case Is = 0: MsgBox "Last day to send your Refund Form for refund.", vbInformation, "Refund Reminder"
            Case Is = 1: MsgBox "One day left to send your Refund Form for refund.", vbInformation, "Refund Reminder"
            Case Is <= 10: MsgBox DaysRemaining & " days left to send your Refund Form for refund.", vbInformation, "Refund Reminder"
        End Select
        
    [COLOR="Red"]End If[/COLOR]
    
End Sub

 

[inta251]

Thanks, AlphaFrog!
Now everything working fine.