Home » excel » excel – Insert Date in TextBox – VBA

excel – Insert Date in TextBox – VBA

Posted by: admin May 14, 2020 Leave a comment

Questions:

I know that we can use function Date in forms for the insertion of the date. But for some dates (such as Hijri Shamsi and Hijri lunar history, etc.), this is impossible and difficult. So I wrote a code that works with the text box. But I think the code that I wrote can be simpler. Do you have a solution to make it simpler?
For example: checking the slash or preventing of Double message display for the moon and day error.

Thanks in advance for the friends who respond.

Private Sub TextBox1_Change()
    'To check the slash in the correct place
    If Mid(TextBox1, 1) = "/" Or Mid(TextBox1, 2) = "/" Or Mid(TextBox1, 3) = "/" Or Mid(TextBox1, 4) = "/" Or Mid(TextBox1, 6) = "/" Or Mid(TextBox1, 7) = "/" Or Mid(TextBox1, 9) = "/" Or Mid(TextBox1, 10) = "/" Then
        MsgBox "Please insert date with format: YYYYMMDD or YYYY/MM/DD"
        SendKeys ("{BACKSPACE}")
    End If
    'Insert the slash automatically
    If TextBox1.TextLength = 8 Then
        Me.TextBox1.Value = Format(Me.TextBox1.Value, "0000/00/00")
    End If

    'Year Error!
    If Mid(TextBox1, 4) = 0 Then
        MsgBox "Year Error!" & vbNewLine & "Please insert date with format: YYYYMMDD or YYYY/MM/DD"
        With TextBox1
            .SelStart = 0
            .SelLength = Len(.Text)
        End With
        Exit Sub
    End If
    'Month Error!
    If TextBox1.TextLength = 10 Then
        If Mid(TextBox1.Value, 6, 2) = 0 Or Mid(TextBox1.Value, 6, 2) > 12 Then
            MsgBox "Month Error!" & vbNewLine & "Please insert date with format: YYYYMMDD or YYYY/MM/DD"
            With TextBox1
                .SelStart = 5
                .SelLength = 2
                '.SelText = ""
            End With
            Exit Sub
        End If
    End If
    'Day Error!
    If TextBox1.TextLength = 10 Then
        If Mid(TextBox1.Value, 9, 2) = 0 Or Mid(TextBox1.Value, 9, 2) > 31 Then
            MsgBox "Day Error!" & vbNewLine & "Please insert date with format: YYYYMMDD or YYYY/MM/DD"
            With TextBox1
                .SelStart = 8
                .SelLength = 2
            End With
            Exit Sub
        End If
    End If
End Sub

Private Sub textbox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    'Accept only number and slash
    If Not Chr(KeyAscii) Like "[0-9,/ ]" Then
        KeyAscii = 0
        MsgBox "Only Numbers Allowed!" & vbNewLine & "Please insert date with format: YYYYMMDD or YYYY/MM/DD"
        With TextBox1
            .SetFocus
            Exit Sub
        End With
    End If
End Sub
How to&Answers:

I am not familiar enough with the calendar forms you’re dealing with, so please understand my example based on a western-style calendar.

The way you’re performing some of your error checking somewhat obscures the values you’e checking. For example,

If Mid(TextBox1.Value, 6, 2) = 0 Or Mid(TextBox1.Value, 6, 2) > 12 Then

is a perfectly valid check, but you’re overusing the Mid function. One suggestion is to parse the date string and pull out substrings into values you’re looking for. As in:

Dim month As Long
month = CLng(Mid$(TextBox1.Value, 6, 2))
If (month = 0) Or (month > 12) Then

this makes more intuitive sense. Yes, it creates an extra variable, but it makes your code much more readable.

Here’s my (untested) version of your code as another example of how it can be done. Notice that I’m separating the error checking into a separate function because it’s more involved. (This way it isn’t cluttering the main routine.)

EDIT: Answer has been updated and tested. Changed the event code from TextBox1_Change and now catching two different events: LostFocus and KeyDown in order to kick off a validation when the user clicks away from the textbox or types Enter while in the textbox.

Option Explicit

Private Enum ValidationError
    LengthError
    FormatError
    YearError
    MonthError
    DayError
    NoErrors
End Enum

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _
                             ByVal Shift As Integer)
    If KeyCode = Asc(vbCr) Then
        ValidateDate
    End If
End Sub

Private Sub TextBox1_LostFocus()
    ValidateDate
End Sub

Private Sub ValidateDate()
    With TextBox1
        Select Case InputIsValidated(.text)
            Case LengthError
                MsgBox "Please insert date with format: YYYYMMDD or YYYY/MM/DD with only numbers and a '/'"
            Case FormatError
                MsgBox "Please insert date with format: YYYYMMDD or YYYY/MM/DD with only numbers and a '/'"
            Case YearError
                .SelStart = 0
                .SelLength = 4
                MsgBox "Invalid Year. Must be between 2015 and 2020"
            Case MonthError
                .SelStart = 5
                .SelLength = 2
                MsgBox "Invalid Month. Must be between 1 and 12"
            Case DayError
                .SelStart = 7
                .SelLength = 2
                MsgBox "Invalid Day. Must be between 1 and 31"
            Case NoErrors
                '--- nothing to do, it's good!
                MsgBox "It's good!"
        End Select
    End With
End Sub

Private Function InputIsValidated(ByRef text As String) As ValidationError
    '--- perform all sorts of checks to validate the input
    '    before any processing
    '--- MUST be the correct length
    If (Len(text) <> 8) And (Len(text) <> 10) Then
        InputIsValidated = LengthError
        Exit Function
    End If

    '--- check if all characters are numbers
    Dim onlyNumbers As String
    onlyNumbers = Replace(text, "/", "")
    If Not IsNumeric(onlyNumbers) Then
        InputIsValidated = FormatError
        Exit Function
    End If

    Dim yyyy As Long
    Dim mm As Long
    Dim dd As Long
    yyyy = Left$(onlyNumbers, 4)
    mm = Mid$(onlyNumbers, 5, 2)
    dd = Right$(onlyNumbers, 2)

    '--- only checks if the numbers are in range
    '    you can make this more involved if you want to check
    '    if, for example, the day for February is between 1-28
    If (yyyy < 2015) Or (yyyy > 2020) Then
        InputIsValidated = YearError
        Exit Function
    End If

    If (mm < 1) Or (mm > 12) Then
        InputIsValidated = MonthError
        Exit Function
    End If

    If (dd < 1) Or (dd > 31) Then
        InputIsValidated = DayError
        Exit Function
    End If

    text = onlyNumbers
    InputIsValidated = NoErrors
End Function

Answer:

Thanks to @PeterT, I corrected the code with guidance @PeterT and I give it to all the interested people. Enjoy it.

Option Explicit

Private Enum ValidationError
    LengthError
    FormatError
    YearError
    MonthError
    DayError
    NoErrors
End Enum

Private Sub TextBox1_Change()
    'To check the slash in the correct place
    If TextBox1.TextLength = 10 Then
        If InStr(Left(TextBox1, 4), "/") Or InStr(Mid(TextBox1, 6, 2), "/") Or InStr(Mid(TextBox1, 9, 2), "/") <> 0 Then
            MsgBox "Please insert date with format: YYYYMMDD or YYYY/MM/DD"
            With TextBox1
            .SelStart = 0
            .SelLength = Len(.text)
            End With
        End If
    End If
    'Insert the slash automatically
    If TextBox1.TextLength = 8 Then
        If InStr(TextBox1, "/") Then
        'nothing
        Else
            Me.TextBox1.Value = Format(Me.TextBox1.Value, "0000/00/00")
        End If
    End If
End Sub

Private Sub textbox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    'Accept only number and slash
    If Not Chr(KeyAscii) Like "[0-9,/ ]" Then
        KeyAscii = 0
        MsgBox "Only Numbers Allowed!" & vbNewLine & "Please insert date with format: YYYYMMDD or YYYY/MM/DD"
    End If
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = Asc(vbCr) Then
        ValidateDate
    End If
End Sub

Private Sub TextBox1_LostFocus()
    ValidateDate
End Sub

Private Sub ValidateDate()
    With TextBox1
        Select Case InputIsValidated(.text)
            Case LengthError
                MsgBox "Please insert date with format: YYYYMMDD or YYYY/MM/DD with only numbers and a '/'"
            Case FormatError
                MsgBox "Please insert date with format: YYYYMMDD or YYYY/MM/DD with only numbers and a '/'"
            Case YearError
                .SelStart = 0
                .SelLength = 4
                MsgBox "Invalid Year. Must be between 2015 and 2020"
            Case MonthError
                .SelStart = 5
                .SelLength = 2
                MsgBox "Invalid Month. Must be between 1 and 12"
            Case DayError
                .SelStart = 8
                .SelLength = 2
                MsgBox "Invalid Day. Must be between 1 and 31"
            Case NoErrors
                '--- nothing to do, it's good!
                MsgBox "It's good!"
        End Select
    End With
End Sub

Private Function InputIsValidated(ByRef text As String) As ValidationError
    '--- perform all sorts of checks to validate the input
    '    before any processing
    '--- MUST be the correct length
    If InStr(TextBox1, "/") And TextBox1.TextLength < 10 Then
        InputIsValidated = FormatError
        Exit Function
    End If

    Dim yyyy As Long
    Dim mm As Long
    Dim dd As Long
    yyyy = Left$(TextBox1, 4)
    mm = Mid$(TextBox1, 6, 2)
    dd = Right$(TextBox1, 2)

    '--- only checks if the numbers are in range
    '    you can make this more involved if you want to check
    '    if, for example, the day for February is between 1-28
    If (yyyy < 2015) Or (yyyy > 2020) Then
        InputIsValidated = YearError
        Exit Function
    End If

    If (mm < 1) Or (mm > 12) Then
        InputIsValidated = MonthError
        Exit Function
    End If

    If (dd < 1) Or (dd > 31) Then
        InputIsValidated = DayError
        Exit Function
    End If

    text = TextBox1
    InputIsValidated = NoErrors
End Function