Force TextBox to be date format

[thorpyuk]

Hiya,

I'd like to import some dates into some textboxes on a userform.

I'm also going to let the user edit these, however... what i'd like is for the user to be forced to:

1) enter a date in the format dd/mm/yy
2) Enter a valid date (eg, not feb 30th)


Please can anyone help?

Thanks

 

[MickG]

Hi, Place this in a Command button on your Userform.
Modify code details to suit.

If UserForm2.TextBox1.Text = Format(UserForm2.TextBox1.Text, "dd/mm/yy") Then
MsgBox "Your Date Format is correct"
Else
MsgBox "You Date Format is incorrect" & vbNewLine & _
"Please Enter date as ""dd/mm/yy"""
End If

Regards Mick

 

[thorpyuk]

Hi MickG,

I've put the code into the textbox1_afterupdate event, but it doesn't seem to quite work:

Private Sub TextBox1_AfterUpdate()
If UserForm4.TextBox1.Text = Format(UserForm4.TextBox1.Text, "dd/mm/yy") Then
MsgBox "Your Date Format is correct"
Else
MsgBox "You Date Format is incorrect" & vbNewLine & _
"Please Enter date as ""dd/mm/yy"""
End If
End Sub

For eg, it will accept dates like 23/03/Gz or 23/03/08A etc

 

[Norie]

Why not allow the user to enter the date in the format they want?

Then check it's a valid date using IsDate and then if needed format as required later in your code.

 

[MickG]

Hi Try this

If UserForm2.TextBox1.Text = Format(UserForm2.TextBox1.Text, "dd/mm/yy") And _
IsDate(UserForm2.TextBox1.Value) = True Then
MsgBox "Your Date Format is correct"
Else
MsgBox "You Date Format is incorrect" & vbNewLine & _
"Please Enter date as ""dd/mm/yy"""
End If

Mick

 

[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 8
        If Char Like "#" Then
            If Len(TextBox1) = 8 Then
                On Error Resume Next
                x = DateValue(TextBox1.Text)
                y = DateSerial(Right(TextBox1, 2), 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/yy", 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

 

[thorpyuk]

Andrew - that's absolutely bloody brilliant... works exactly how i need it to!

 

[thorpyuk]

Hi Andrew,

One slight kink -

When i try to load data into the textbox, it cuts off the 1st part of the year...

For eg, my dates are stored as 01/01/2008

What will display in the textbox is 01/01/20

Is there a way around this one? :s

 

[Andrew Poulsom]

I can think of three options:

- format the date as dd/mm/yy before you load it
- disable the Change event when loading
- have the user enter dates as dd/mm/yyyy and change the code to accommodate it

 

[thorpyuk]

Thanks Andrew, i've changed it to: (which seems to work)

Private Sub TextBox2_Change()
    Dim Char As String
    Dim x As Date
    Dim y As Date
    Char = Right(TextBox2.Text, 1)
    Select Case Len(TextBox2.Text)
    Case 1 To 2, 4 To 5, 7 To 10
        If Char Like "#" Then
            If Len(TextBox2) = 10 Then
                On Error Resume Next
                x = DateValue(TextBox2.Text)
                y = DateSerial(Right(TextBox2, 4), Mid(TextBox2, 4, 2), Left(TextBox2, 2))
                If Err = 0 And x = y Then
                    On Error GoTo 0
                    Exit Sub
                Else
                    Err.Clear
                    On Error GoTo 0
                    TextBox2.SelStart = 0
                    TextBox2.SelLength = Len(TextBox2.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
    TextBox2.Text = Left(TextBox2.Text, Len(TextBox2.Text) - 1)
    TextBox2.SelStart = Len(TextBox2.Text)
End Sub