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.

 

[dmt32]

Hi,
don't worry too much how user enters a date - so long as they enter a valid date in any format, you would apply the required format to the range using NumberFormat

example

Private Sub CommandButton19_Click()
    
    Dim TDate       As Variant
    
    Do
        TDate = InputBox("Please enter the New FTD Date", "New FTD")
        'cancel pressed
        If StrPtr(TDate) = 0 Then Exit Sub
    Loop Until IsDate(TDate)
    
    With Range("ActTaken")
        .Value = CDate(TDate)
        .NumberFormat = "mm/dd/yyyy"
    End With
    
End Sub

If you enter a date in InputBox like 14 Feb 2024 it should display your required format in specified range 02/14/2024

Dave

 

[AndyTampa]

Hi,
don't worry too much how user enters a date - so long as they enter a valid date in any format, you would apply the required format to the range using NumberFormat

example

Private Sub CommandButton19_Click()
   
    Dim TDate       As Variant
   
    Do
        TDate = InputBox("Please enter the New FTD Date", "New FTD")
        'cancel pressed
        If StrPtr(TDate) = 0 Then Exit Sub
    Loop Until IsDate(TDate)
   
    With Range("ActTaken")
        .Value = CDate(TDate)
        .NumberFormat = "mm/dd/yyyy"
    End With
   
End Sub

If you enter a date in InputBox like 14 Feb 2024 it should display your required format in specified range 02/14/2024

Dave

That doesn't do what I wanted. Entering 5/24 still gets 5/24/2024 and entering 5.7 still gets 5:07:00AM. Both need to be rejected. Also, I believe where you have With Range and .Value and .NumberFormat, you are simply putting the entry into the cell and erasing everything that was already there, which is not what I need to do. I need to make the date part of a long text string to be added to whatever is already in the cell.

Anything that can be interpreted as a date by Excel will be found to be valid for this macro. That does not work for my purposes.

 

[Akuini]

The only formats I want to be accepted are mm/dd/yyyy, mm/dd/yy or m/d/yy.

Maybe this:

Private Sub CommandButton19_Click()

Dim String1 As String
Dim TDate As String
Dim dt
Dim flag As Boolean
String1 = Range("PCase")

TDate = InputBox("Please enter the new FTD in the format MM/DD/YYYY.", "New FTD")
flag = False

dt = Split(TDate, "/")
If UBound(dt) = 2 Then
    If (dt(0) Like "#" Or dt(0) Like "##") And (dt(1) Like "#" Or dt(1) Like "##") Then
        If dt(0) > 0 And dt(0) < 13 Then 'month
            If dt(1) > 0 And dt(1) < 32 Then 'day
                If dt(2) Like "##" Or dt(2) Like "####" Then 'year
                    flag = True
                End If
            End If
        End If
    End If
End If

If flag = True 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

The code allows only "/" as the separator.

 

[dmt32]

That doesn't do what I wanted.

Then I have misunderstood your requirement – sorry about that perhaps others can resolve for you.

Dave

 

[AndyTampa]

Maybe this:

Private Sub CommandButton19_Click()

Dim String1 As String
Dim TDate As String
Dim dt
Dim flag As Boolean
String1 = Range("PCase")

TDate = InputBox("Please enter the new FTD in the format MM/DD/YYYY.", "New FTD")
flag = False

dt = Split(TDate, "/")
If UBound(dt) = 2 Then
    If (dt(0) Like "#" Or dt(0) Like "##") And (dt(1) Like "#" Or dt(1) Like "##") Then
        If dt(0) > 0 And dt(0) < 13 Then 'month
            If dt(1) > 0 And dt(1) < 32 Then 'day
                If dt(2) Like "##" Or dt(2) Like "####" Then 'year
                    flag = True
                End If
            End If
        End If
    End If
End If

If flag = True 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

The code allows only "/" as the separator.

You've turned a date into an array. That's brilliant. I've never fully understood arrays, but this one is simple enough for me to follow. I was able to edit it a little since all requirements must be true. Unfortunately, when I tried using a single If statement, I got an Out of Range error. I had to make the If UBound statement separate but joined the rest and it seems to work.

Dim String1 As String
Dim TDate As String
Dim dt
String1 = Range("PCase")

TDate = InputBox("Please enter the new FTD in the format MM/DD/YYYY.", "New FTD")

dt = Split(TDate, "/")

If StrPtr(TDate) = 0 Or TDate = vbNullString Then Exit Sub

If UBound(dt) = 2 Then
    If (dt(0) Like "#" Or dt(0) Like "##") And (dt(1) Like "#" Or dt(1) Like "##") _
    And (dt(2) Like "##" Or dt(2) Like "####") _
    And dt(0) > 0 And dt(0) < 13 And dt(1) > 0 And dt(1) < 32 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. Please enter a valid date."
    End If
Else
    MsgBox (TDate & " is not a date.")
End If

You can see that I also removed the True/False statements, but now that I've been thinking about it, I could still put them in and use call the macro for each button that needs to use it. All I'd need is a True/False out of it. As I have it here, I'd have to put all this code into each button that asks for a date. It would be a lot easier to just call the routine. What I do like about the above is that the msgboxes differentiate between 'not a date' and 'invalid date'.

The new hurdle is how to use this one code from several other buttons and pass the True/False, or even a third option to identify when the user (me) enters something not even a date, result back to the requesting macro. I can settle for True/False though.

I've never been able to figure that out in the few short windows I have on this work computer. Can you assist with that or should I make a new post? And if anyone provides the code, could you explain how it works?

 

[AndyTampa]

I just found a hole in the code. It will accept 9/31/24 or 2/30/24 as valid dates and then give a Debug error when it gets to CDate. Have you got a fix for that?

 

[Akuini]

@AndyTampa
Dealing with dates can be tricky. When we try to convert a string to a date, we may get unexpected results. The usual problems are:

• The day, month, and year may get swapped.
• What we consider to be a wrong date format is actually considered valid by VBA.

So, here's my attempt to deal with such problems.
I created a function called "true_date" to ensure that the string-to-date conversion is as we expected, using DateSerial.
Please try it with various scenarios. I'll explain the code in more detail later.

Function true_date(a, b, c) As Boolean

Dim qt As Date
   qt = DateSerial(a, b, c)
   If Year(qt) = a And Month(qt) = b And Day(qt) = c Then true_date = True

End Function

Sub test_true_date()        
'the arguments must be numeric and in this order: year,month,day        
'year must be 4 digit        
Debug.Print true_date(2024, 3, 4)        'True
Debug.Print true_date(2024, "3", 4)        'False
Debug.Print true_date(2024, 3, 4.2)        'False
Debug.Print true_date(2024, 3, 34)        'False
Debug.Print true_date(2024, 3, 30)        'True
Debug.Print true_date(24, 3, 30)        'False
Debug.Print true_date(2024, 2, 30))        'False
        
End Sub

And applied to your code.
Note: I commented some part of your code for testing purpose, so just try it by changing this part: TDate = "9/18/24"

Dim String1 As String
Dim TDate As String
Dim dt
Dim flag As Boolean
Dim qt As Date

'String1 = Range("PCase")
'TDate = InputBox("Please enter the new FTD in the format MM/DD/YYYY.", "New FTD")
'If StrPtr(TDate) = 0 Or TDate = vbNullString Then Exit Sub

TDate = "9/18/24"

flag = False

If IsDate(TDate) Then
    dt = Split(TDate, "/")
    If UBound(dt) = 2 Then

        If IsNumeric(dt(0)) And IsNumeric(dt(1)) And IsNumeric(dt(2)) Then
             If dt(2) Like "##" Then
                dt(2) = "20" & dt(2)  'if year is only 2 digit then add "20" in front of it
             ElseIf Not dt(2) Like "####" Then
                MsgBox "Oops. Please enter a valid date."
                Exit Sub
             End If
             
             qt = DateSerial(dt(2), dt(0), dt(1)) 'year-month-day
             If true_date(Val(dt(2)), Val(dt(0)), Val(dt(1))) Then
               TDate = CDate(qt)
               '    Range("ActTaken") = Range("ActTaken") & " The existing FTD has been removed from case" & String1 & _
                '    " and replaced with a " & TDate & " FTD as "
               flag = True
               MsgBox "Correct: " & TDate
             End If
        End If
    
    End If
    
    If flag = False Then MsgBox "Oops. Please enter a valid date."

Else
    
    MsgBox "Oops. Next time enter a date."

End If
End Sub

 

[Akuini]

Here's a followed up:
Dealing with date is tricky, when we try to convert a string to a date we probably get unexpected result. Usually the problem are:
- the day, month & year get swapped
- what we consider as wrong date format is actually considered valid by vba

My Windows date setting uses d-m-y format, so all examples below generate results base on that setting.

Example 1: the day & month get swapped

Sub test_1()
'tested on dmy windows setting
Dim tx As String
    tx = "3/6/24"
    Debug.Print Month(CDate(tx)) 'return 6
    Range("A1") = tx
    Debug.Print Month(CDate(Range("A1"))) 'return 3
End Sub

Example 2:
The DateSerial function's arguments are always in this order: year, month, day. This consistency is beneficial because it helps prevent confusion. However, one issue when using DateSerial is that it accepts values that we would typically consider incorrect, such as day 32 or month 20.
Here's an example:

Sub test_2()
'tested on dmy windows setting
Debug.Print DateSerial(2024, 1, 32) 'return: 01/02/2024 , so 32-Jan become 1-Feb
Debug.Print DateSerial(2024, 20, 3) 'return: 03/08/2025

End Sub

To deal with such problems I've created Function True_Date (in post #8) and then I've revised it to make it simpler to use.
In this function, what is considered a valid date has the following criteria:

1. The argument value must be an integer
2. The argument must be in this order: year-month-day.
3. The year must be 2 or 4 digits. If it's 2 digits, then it will be preceded by "20"
4. The day, month, and year are not changed in the result obtained from the text-to-date conversion using DateSerial.

Function True_Date(ByVal a, ByVal b, ByVal c) As Boolean
'In this function, what is considered a valid date has the following criteria:
'  The argument value must be an integer
'  The argument must be in this order: year-month-day.
'  The year must be 2 or 4 digits. If it's 2 digits, then it will be preceded by "20"
'  The day, month, and year are not changed in the result obtained from the text-to-date conversion using DateSerial.

Dim TD As Date
   If IsDate(a & "/" & b & "/" & c) And (a Like "####" Or a Like "##") Then
        If a Like "##" Then a = "20" & a
        
        On Error Resume Next
         TD = DateSerial(a, b, c)
            If Err.Number = 0 Then
              If Year(TD) = Val(a) And Month(TD) = Val(b) And Day(TD) = Val(c) Then True_Date = True
            End If
        On Error GoTo 0
        
    End If
End Function

Sub check_date_testing_2()
'Note: I commented some part of your code for testing purpose, so just try it by changing this part: TDate = "9/18/24"  'change this part to test
Dim String1 As String
Dim TDate As String
Dim dt
Dim flag As Boolean
Dim qt As Date

'String1 = Range("PCase")
'TDate = InputBox("Please enter the new FTD in the format MM/DD/YYYY.", "New FTD")
'If StrPtr(TDate) = 0 Or TDate = vbNullString Then Exit Sub

TDate = "9/18/24" 'change this part to test

If IsDate(TDate) Then
    dt = Split(TDate, "/")
    
    If UBound(dt) = 2 Then
             If True_Date(dt(2), dt(0), dt(1)) Then
                qt = DateSerial(dt(2), dt(0), dt(1)) 'year-month-day
                TDate = CDate(qt)
                '    Range("ActTaken") = Range("ActTaken") & " The existing FTD has been removed from case" & String1 & _
                 '    " and replaced with a " & TDate & " FTD as "
                flag = True
                MsgBox "Correct: " & TDate

             End If
    End If
    
    If flag = False Then MsgBox "Oops. Please enter a valid date."

Else
    
    MsgBox "Oops. Next time enter a date."

End If
End Sub

This is just for testing:

Sub just_test_1()

'these return TRUE
Debug.Print True_Date(2024, 3, 4)
Debug.Print True_Date(2024, "03", 14)
Debug.Print True_Date(2024, 3, 30)
Debug.Print True_Date(24, 3, 3)

'these return FALSE
Debug.Print True_Date(2024, 3, 4.2)
Debug.Print True_Date(2024, 3, 34)
Debug.Print True_Date(234, 3, 3)
Debug.Print True_Date(2024, 2, 30)
Debug.Print True_Date(2024, "Feb", 4)
Debug.Print True_Date(2024, 3, "")
Debug.Print True_Date(2024, 2, 30)
End Sub

Comparing DateSerial & True_Date:

Sub test_3()
'(note: my system uses dmy format)
Debug.Print DateSerial(2024, 1, 32) 'return: 01/02/2024 , so 32-Jan become 1-Feb
Debug.Print DateSerial(2024, 20, 3) 'return: 03/08/2025
Debug.Print True_Date(2024, 1, 32)  'return: false
Debug.Print True_Date(2024, 20, 3) 'return: false
End Sub

 

[AndyTampa]

Wow. That's a little advanced for me. It's going to take me some time to digest that and I don't have the time at work to try. I can't send home the worksheet to work on it either. Once I figure it out, I'll try it and respond.