Date Error Checking

[AndrewKent]

Hi there,

I have a ActiveX TextBox on a spreadsheet that I want to fit some error checking into.

Basically I want it only to accept dates in "01/01/2011" format.

Can anyone help me out?

Kind regards,

Andy

 

[Andrew Poulsom]

Try:

Private Sub TextBox1_Change()
    Dim Char As String
    Dim x As Date
    Dim y As Date
    Char = Right(TextBox1.Text, 1)
    Select Case Len(TextBox1.Text)
    Case 1 To 2, 4 To 5, 7 To 10
        If Char Like "#" Then
            If Len(TextBox1) = 10 Then
                On Error Resume Next
                x = DateValue(TextBox1.Text)
                y = DateSerial(Right(TextBox1, 4), Mid(TextBox1, 4, 2), Left(TextBox1, 2))
                If Err = 0 And x = y Then
                    On Error GoTo 0
                    Exit Sub
                Else
                    Err.Clear
                    On Error GoTo 0
                    TextBox1.SelStart = 0
                    TextBox1.SelLength = Len(TextBox1.Text)
                    MsgBox "Please enter a valid date in the form dd/mm/yyyy", vbCritical + vbOKOnly, "Error"
                    Exit Sub
                End If
            Else
                Exit Sub
            End If
        End If
    Case 3, 6
        If Char Like "/" Then Exit Sub
    End Select
    Beep
    On Error Resume Next
    TextBox1.Text = Left(TextBox1.Text, Len(TextBox1.Text) - 1)
    TextBox1.SelStart = Len(TextBox1.Text)
End Sub

 

[AlphaFrog]

To add to Andrew's most clever code...

One situation not covered is if the user enters in a partial valid date (e.g. 01/0) and then clicks on a cell. That entry would be accepted.

Include this additional code to exclude partial date entries.

Private Sub TextBox1_LostFocus()
    With TextBox1
        If Not (Len(.Text) = 10 Or Len(.Text) = 0) Then
           .Text = vbNullString
           MsgBox "Please enter a valid date in the form dd/mm/yyyy", vbCritical + vbOKOnly, "Error"
        End If
    End With
End Sub