0
votes

I have a code that allows me to manually enter date in textbox1 which then gets selected in the calendar on the useform. There is a second textbox that allows me to add or subtract dates. The code works perfectly.

Userform Code -

Option Explicit 
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) 
    If IsDate(Me.TextBox1.Value) Then Me.Calendar1.Value = Me.TextBox1.Value 
End Sub 
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean) 
    Dim dt As Date 
    With Me 
        If IsDate(.TextBox1.Value) Then 
            dt = CDate(.TextBox1.Value) + Val(.TextBox2.Value)
            .TextBox1.Value = dt 
            .Calendar1.Value = dt
        End If 
    End With 
End Sub 

I would like to manually enter date in textbox1 in a specific format.

The formats will be -

dd

ddmmm

ddmmmyyy

I'm not sure how to write a code that does this.

The idea is to enter date in either of the 3 formats specified above in textbox1, which then gets selected on the calendar on the userform.

1

1 Answers

0
votes

edited after op's clarification about allowed formats

you could build upon the following code

Option Explicit

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim txt As String, dayStr As String, monthStr As String, yearStr As String
    Dim okTxt As Boolean

    txt = Me.TextBox1.Value
    Select Case Len(txt)
        Case 2
            dayStr = txt
            okTxt = okDay(dayStr)
            monthStr = month(Now)
            yearStr = year(Now)
        Case 5
            dayStr = Mid(txt, 3, 3)
            monthStr = Mid(txt, 3, 3)
            okTxt = okDay(Left(txt, 2)) And okMonth(monthStr)
            yearStr = year(Now)
        Case 7
            dayStr = Mid(txt, 3, 3)
            monthStr = Mid(txt, 3, 3)
            yearStr = Mid(txt, 6, 2)
            okTxt = okDay(Left(txt, 2)) And okMonth(monthStr) And okYear(yearStr)
    End Select
    If Not okTxt Then
        MsgBox "Invalid date" _
               & vbCrLf & vbCrLf & "Date must be input in one of the following formats:" _
               & vbCrLf & vbTab & "dd" _
               & vbCrLf & vbTab & "ddmmm" _
               & vbCrLf & vbTab & "ddmmmyy" _
               & vbCrLf & vbCrLf & "Please try again", vbCritical

        Cancel = True
    Else
        Me.Calendar1.Value = CDate(Left(txt, 2) & " " & monthStr & " " & yearStr)
    End If
End Sub

Function okDay(txt As String) As Boolean
    okDay = CInt(txt) > 0 And CInt(txt) < 31
End Function

Function okMonth(txt As String) As Boolean
    Const months As String = "JANFEBMARAPRMAJJUNJULAUGSEPOCTNOVDEC"
    okMonth = InStr(months, UCase(txt)) > 0
End Function

Function okYear(txt As String) As Boolean
    okYear = CInt(txt) > 0 And CInt(txt) < 200 '<--| set your "limit" years
End Function