InputBox to ask for date and only accept standard date formats

[AndyTampa]

I have this spreadsheet I use with templates on it. I am constantly typing the same notes into this one template so I started creating buttons that will append the text with more text. I've ventured into message boxes and input boxes for when I didn't fill a cell or just need something specific added in the middle of the text. I've never used these boxes before.

I've got one button that I've (sort of) gotten to work, but I'd like to perfect it if possible. It's an input box that asks for a date. I've tried all sorts of solutions I've found online but there are issues with all of them.

Here's what I've got so far.

Private Sub CommandButton19_Click()

Dim String1 As String
Dim TDate As String

String1 = Range("PCase")

TDate = InputBox("Please enter the new FTD in the format MM/DD/YYYY.", "New FTD")
   
If IsDate(TDate) Then
    TDate = CDate(TDate)
    Range("ActTaken") = Range("ActTaken") & " The existing FTD has been removed from case" & String1 & _
    " and replaced with a " & TDate & " FTD as "
Else
    MsgBox "Oops. Next time enter a date."
End If

End Sub

This mostly works. However, IsDate accepts decimal numbers and provides output as a time and also accepts short month-day inputs, converting them to a date and assuming they are 2024. The only formats I want to be accepted are mm/dd/yyyy, mm/dd/yy or m/d/yy.

I've tried testing the input with the below but get a Type Mismatch error if it's not right.

If Not VBA.Format(TDate, "mm/dd/yyyy") Then

Format doesn't work without the VBA. in front of it.

I've also tried testing the input with the below but it won't accept dates like 5/5/24.

If TDate Like "[0-1][0-9]/[0-3][0-9]/[1-2][0-9][0-9][0-9]" Then

Since I'm unfamiliar with the InputBox, I was wondering if there was any way to force it to only accept actual dates only.

 

[Akuini]

This is why we all use a very slow and clumsy Date Picker on forms, programmers don't trust users, for a good reason.

Based on your experience, what Date Picker (on userform) do you consider to be a good one?

 

[AndyTampa]

I apologize for the delay. There are some impediments to using the forum for items I use at work.
1) My time is limited and monitored at work.
2) I have trouble seeing the text in this forum on my personal laptop. All the code is in a thinner font on a darker background which makes it difficult to see.
3) I try to copy the text and email it to my work email, but sometimes it gets blocked by security software.

It's time-consuming and we are overloaded with work right now.

Let me answer a question someone had. I am not providing this template to any other users so trusting their input is not an issue. I make changes in our system and must document not only the cases I'm working on, but the tickets that the work comes in on. Certain templates must sometimes be used. I've created buttons to fill in these templates with text I use quite often. Some of these notes require a variable. I'm creating the macros to ask for those variables. Checking the date keeps the content consistent and correct. Sometimes I use a 2-digit year and sometimes a 4-digit year. Creating these macros also helps me understand VBA a little better each time. I couldn't find a clear solution online, so I came to you nice helpful folks.

In regard to a Date Picker, my excel at work doesn't have a date picker and I am forbidden from installing anything which would include add-ins. Oddly, MS provides one in Word but not Excel.

Because of all the hubbub surrounding AI, I tried ChatGPT for the first time recently. It produced solutions that didn't work, but it was intuitive enough that I could actually talk to it and tweak its suggestions. I also used some of what you've provided to add those tweaks. It produced a so-far workable solution and testing looks promising, but I haven't implemented it yet. It does not use the DateSerial method. I'm on my home computer right now, so I don't have the text I used, but I will post it when time permits.

I am using a function (for the first time ever). It does use a Loop until the date is valid. It does split the input, but then it uses the year part to determine if the 4-digit year should be this century or last century. Then it Joins the three parts together again to display the date appropriately. It also passes this date back to the macro from which the function was called.

I have to say that this thread has helped me to get the AI going in the right direction to produce a usable result. I appreciate all the help.

 

[AndyTampa]

Is it okay to post my result if I used ChatGPT? It is my own question, after all.

 

[Akuini]

Is it okay to post my result if I used ChatGPT? It is my own question, after all.

In this case, you're answering your own question, so I think it's ok.
But I'm not a moderator so probably a moderator (@Fluff, @Peter_SSs) should answer this.

 

[Peter_SSs]

Is it okay to post my result if I used ChatGPT? It is my own question, after all.

Yes

 

[AndyTampa]

So the button has a loop to call the function.

Private Sub CommandButton21_Click()

Dim EffDate As Variant

Do
    ' Prompt user to enter a date
    EffDate = InputBox("Please enter the FTD (mm/dd/yyyy format):", "Future Term Date?", "xx/xx/xxxx")
    
    ' Check if user pressed Cancel or closed the input box
    If EffDate = "" Then
        MsgBox "Operation canceled by user.", vbInformation
        Exit Sub
    End If

    ' Call the date validation function
    If ValidateDate(EffDate) Then Exit Do

Loop

Once the loop is done, the button will continue using the new EffDate created by the function. Here is the function:

Function ValidateDate(EffDate As Variant) As Boolean
    ' Check if input is a valid date
    ValidateDate = False
    If Not IsDate(EffDate) Then
        MsgBox EffDate & " is not a date. Please enter a valid date in mm/dd/yyyy format.", vbExclamation, "Date Invalid"
        Exit Function
    End If

    ' Split the input date into day, month, and year parts
    Dim dateParts() As String
    dateParts = Split(EffDate, "/")

    ' Check if input date has exactly three parts (day, month, year)
    If UBound(dateParts) <> 2 Then
        MsgBox EffDate & " is not a valid date. Please enter the date in mm/dd/yyyy format.", vbExclamation, "Date Invalid"
        Exit Function
    End If

    ' Check if day, month, and year parts are numeric
    If Not IsNumeric(dateParts(0)) Or Not IsNumeric(dateParts(1)) Or Not IsNumeric(dateParts(2)) Then
        MsgBox EffDate & " is not a valid date. Please enter the date in mm/dd/yyyy format.", vbExclamation, "Date Invalid"
        Exit Function
    End If

    ' Check if the year part has 2 or 4 digits
    If Len(dateParts(2)) <> 2 And Len(dateParts(2)) <> 4 Then
        MsgBox EffDate & " is not a valid date. Please enter the year with 2 or 4 digits.", vbExclamation, "Date Invalid"
        Exit Function
    End If
    
        ' If the year part has 2 digits, convert it to 4 digits
    If Len(dateParts(2)) = 2 Then
        Dim yearPart As Integer
        yearPart = CInt(dateParts(2))
        If yearPart >= 0 And yearPart <= 99 Then
            If yearPart >= 0 And yearPart <= Year(Now) Mod 100 Then
                dateParts(2) = yearPart + Int(Year(Now) / 100) * 100
            Else
                dateParts(2) = yearPart + Int((Year(Now) - 100) / 100) * 100
            End If
            EffDate = Join(dateParts, "/")
        End If
    End If

    ' If all conditions are met, return True
    ValidateDate = True
End Function

It's a little bulky, but at least the different tests are easily recognized. I'm hoping to eventually get it trimmed down so it doesn't have 4 separate error messages. But for now, I have many more fish to fry. So far, it's working, unless someone sees a problem with it. You can see it has influences of many responses here and I think I guided it in that direction based on your responses. The one thing I've learned about ChatGPT is that it's almost always wrong on the first try. You have to know what you want and tweak the results and test them. They aren't reliable on their own.

 

[Akuini]

@AndyTampa
Glad you figured it out.

I am not providing this template to any other users so trusting their input is not an issue.

I haven't reviewed your last code, but since you're going to use it by yourself, I think that should be enough.

And in case you're interested, I posted an article about text-to-date conversion. Its content is primarily derived from the discussion with you and @Tupe77 in this thread. So, thanks to both of you.
Excel VBA: Function to Obtain Correct Date Format When Converting Text to Date

 

[AndyTampa]

That's cool and you're welcome. However, I don't think I can take any credit since I only presented the question and relayed results I found from another source; ChatGPT. I will take credit for continuing the conversation though and applaud your result.