DoubleClick event to enter date

[FryGirl]

I have a spreadsheet where column H:I will receive a date. All of this is done thru a DoubleClick event with calls the calendar function. All of this works well. Now I need to ensure the user does not simply enter something into the cell that is not a date. I've added a SheetChange event and it seems to be working well, but just curios if this is the proper way to do it? This DoubleClick event is happening on multiple sheets therefore in the ThisWorkbook module.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Target.CountLarge > 1 Or Target.Row < 3 Then Exit Sub
If Sh.Range("A1").Value = "Unit" Then
If Not Intersect(Target, Sh.Range("H:I")) Is Nothing Then
Call AskFor_A_Date
End If
End If
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.CountLarge > 1 Or Target.Row < 3 Then Exit Sub
Dim msg As String: msg = "Please double click in the cell and use the calendar to enter a date"
If Sh.Range("A1").Value = "Unit" Then
If Not Intersect(Target, Sh.Range("H:I")) Is Nothing Then
If Not IsNumeric(Target.Value) Then
Application.EnableEvents = False
Target.ClearContents
CreateObject("WScript.Shell").Popup msg, 1, "Enter Date"
Target.Select
Application.EnableEvents = True
End If
End If
End If
End Sub

 

[FryGirl]

Ok, I think this will do it.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.CountLarge > 1 Or Target.Row < 3 Then Exit Sub
    Dim oldDate As Date: oldDate = Date - 365
    Dim lateDate As Date: lateDate = Date + 365
    Dim msg As String: msg = "Please double click in the cell and use the calendar to enter a date"
    If Sh.Range("A1").Value = "Unit" Then
        If Not Intersect(Target, Sh.Range("H:I")) Is Nothing Then
            If Target.Value < Int(CDbl(oldDate)) Or Target.Value > Int(CDbl(lateDate)) Or Not IsNumeric(Target.Value) Then
                Application.EnableEvents = False
                Target.Select
                Call AskFor_A_Date
                Application.EnableEvents = True
            End If
        End If
    End If
End Sub

 

[JackDanIce]

Hi Fluff,

How about if I just check the manually entered number to make sure it falls between today -/+ 365?

I don't think this will necessarily work exactly as you want because of possible incorrect data conversions, say at future date and/or by user (intentionally or not)

@Fluff earlier suggestion of locking the columns from user-entry just removes the whole mechanism for the user to even enter data into the cell so you can avoid extra processing or code needed to check/test data entry.

Locking the columns doesn't mean the user can't select the cell, so they can and infact are forced to double-click which triggers your code - without adding anything new to do the testing/checking part!

Ignore - just seen your post and the CDbl for conversion, that should cover any incorrect data inputs!