Input Box with Values and Dates

[ADSkinner]

Hello all.

I have created a drop down list with specific entries I want to allow, one of which being a date.

As the user then selects the option of "Date" I have added the code below, however what I am looking to have it accomplish is that no date earlier than today is allowed as their entry. They must always enter a future date.
When running this code, it accepts future dates as well as past dates. Is there something that I am missing?

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("$D$1:$D$10")) Is Nothing Then Exit Sub
On Error GoTo Trap
Dim rspn As Variant
Application.EnableEvents = False
If Target = "Date" Then
   rspn = InputBox("Enter a valid date")
      If rspn > Date Then
          Target = rspn
      Else: MsgBox "Invalid Date"
      End If
      
End If
Trap: Application.EnableEvents = True
End Sub

 

[Joe4]

Change this variable declaration:

Dim rspn As Variant

to this:

Dim rspn As Date

and it will work.

 

[ADSkinner]

Thank you very much Joe4, that worked perfectly!!!

 

[Joe4]

You are welcome.
By delcaring as "Variant", Excel was converting it to Text, so your value check wasn't working correctly.