'Ensure InputBox date entry is in mm/dd/yyyy format

My code runs, however, I found that when user enters dd/mm/yy, it is accepted when it should not.

How can I trap if the user does not enter mm/dd/yyyy?

Dim LastReportDate As String
Dim StartDate As String

reTry:

LastReportDate = InputBox("Insert date in format mm/dd/yyyy", "Date Range Validated:", Format(Now(), "mm/dd/yyyy"))

'User Presses "Cancel"
If StrPtr(LastReportDate) = 0 Then MsgBox "Cancel button pressed, Data Range Validated - Range (B3) will be blank.", vbCritical, "User Cancelled Date Entry": Exit Sub

'If user does not enter anthying restart at 0
If LastReportDate = vbNullString And StrPtr(LastReportDate) > 0 Then MsgBox "You entered no string": GoTo reTry

'If user did enter a date, then go validate it
If LastReportDate <> vbNullString Then: GoTo ValidateDateFormat

ValidateDateFormat:
'User Entered a Valid Date
If IsDate(LastReportDate) Then

    'Put start date - end date in B3
    'Note start date = -6 days: Data Range Validation is one week
    ThisWorkbook.Worksheets(1).cells(3, 2).Value = DateAdd("d", -6, LastReportDate) & " - " & LastReportDate
    'If user entered wrong date format then go to 0
Else
    MsgBox "Wrong Date Format": GoTo reTry
End If


Solution 1:[1]

Dim LastReportDate As String
Dim StartDate As String

reTry:

LastReportDate = InputBox("Insert date in format mm/dd/yyyy", "Date Range Validated:", Format(Now(), "mm/dd/yyyy"))

'User Presses "Cancel"
If StrPtr(LastReportDate) = 0 Then MsgBox "Cancel button pressed, Data Range Validated - Range (B3) will be blank.", vbCritical, "User Cancelled Date Entry": Exit Sub

'If user does not enter anthying restart at 0
If LastReportDate = vbNullString And StrPtr(LastReportDate) > 0 Then MsgBox "You entered no string": GoTo reTry

'If user did enter a date, then go validate it
If LastReportDate <> vbNullString Then: GoTo ValidateDateFormat


ValidateDateFormat:

'Trap user if the user did not enter the required format
'Thanks @cyboashu
If Format(LastReportDate, "mm/dd/yyyy") <> LastReportDate Then
MsgBox "Wrong Date Format": GoTo reTry

'User Entered a Valid Date
ElseIf IsDate(LastReportDate) Then

     'Put start date - end date in B3
     'Note start date = -6 days: Data Range Validation is one week
ThisWorkbook.Worksheets(1).cells(3, 2).Value = DateAdd("d", -6, LastReportDate) & " - " & LastReportDate
     'If user entered wrong date format then go to 0
Else
End If

MsgBox "CFR Macro Completed.", vbInformation + vbOKOnly, "Macro Status: Successful"
ThisWorkbook.Worksheets(1).Range("B4") = Format(Now, "mm/dd/yyyy")
ThisWorkbook.Worksheets(1).Range("B2").Select

Solution 2:[2]

Instead of all that jumping about using GoTo how about using a loop.

This will prompt the user until they enter a valid date in the correct format or hit Cancel.

Dim LastReportDate As String
Dim StartDate As String
Dim boolValidDate

    Do

        LastReportDate = InputBox("Insert date in format mm/dd/yyyy", "Date Range Validated:", Format(Now(), "mm/dd/yyyy"))

        'User Presses "Cancel"
        If StrPtr(LastReportDate) = 0 Then
            MsgBox "Cancel button pressed, Data Range Validated - Range (B3) will be blank.", vbCritical, "User Cancelled Date Entry"
            Exit Sub
        End If

        boolValidDate = Format(LastReportDate, "mm/dd/yyyy") = LastReportDate

        If Not boolValidDate Then
            MsgBox "Wrong Date Format"
        ElseIf IsDate(LastReportDate) Then
            'Put start date - end date in B3
            'Note start date = -6 days: Data Range Validation is one week
            ThisWorkbook.Worksheets(1).Cells(3, 2).Value = DateAdd("d", -6, LastReportDate) & " - " & LastReportDate
        End If

    Loop Until boolValidDate

    MsgBox "CFR Macro Completed.", vbInformation + vbOKOnly, "Macro Status: Successful"
    ThisWorkbook.Worksheets(1).Range("B4") = Format(Now, "mm/dd/yyyy")
    ThisWorkbook.Worksheets(1).Range("B2").Select

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 ASE Dev
Solution 2 norie