How do I loop an input box one additional time if criteria is not met?

Question

I’m trying to create a series of input boxes that will prompt for more information before executing the rest of the code.

I’m stuck on the looping aspect.

The first input box is for a start date. Valid entries will be a 6-digit numeric value only (unless there’s a less fussy way to prompt for a date). If “999999” is entered, the macro would skip the next input box (for the end date).

I’d like to leave a little room for user error, so if they type “01012021” or “01/01/21” or “p010121” I’d like the input box to loop one time before exiting the sub.

I tried executing this code and my Excel froze up and crashed.

Sub test()
Dim sdate As String, edate As String

DOS_all = False

sdate = InputBox("Enter the first DOS you'd like to search for:" & Chr(10) & "(enter in 6-digit format. e.g., 010121)" & Chr(10) & Chr(10) & "Enter '999999' to search ALL available AHI data.", "Date of service begin", "999999")
   
Do
    If sdate = "" Then
        MsgBox "User canceled or did not enter any data. Macro will end.", , "User canceled"
        Exit Sub
        If sdate = "999999" Then
            DOS_all = True
            Exit Do
            If Not IsNumeric(sdate) Or Len(sdate) <> 6 Then
                MsgBox "Enter the date as 6 digit number ONLY (eg. 010121)", , "Invalid entry"
            End If
        End If
    End If
   
Loop Until IsNumeric(sdate) And Len(sdate) = 6

If DOS_all = False Then 
    edate = InputBox("Enter the last DOS you'd like to search for:" & Chr(10) & "(enter in 6-digit format. e.g., 123121)" & Chr(10) & Chr(10) & "Enter '999999' to make end date today..", "Date of service end", "999999")
End if

Do
    If edate = "" Then
        MsgBox "User canceled or did not enter any data. Macro will end.", , "User canceled"
        Exit Sub
        If edate = "999999" Then
            edate = Date
            Exit Do
            If Not IsNumeric(sdate) Or Len(sdate) <> 6 Then
                MsgBox "Enter the date as 6 digit number ONLY (eg. 123121)", , "Invalid entry"
            End If
        End If
    End If
   
Loop Until IsNumeric(sdate) And Len(sdate) = 6

End Sub

[The answers to this question may be of use](https://stackoverflow.com/questions/19430765/input-box-date-range-in-vba) — cybernetic.nomad, Feb 24 '22 at 22:46

score 0 · Answer 1 · answered Feb 25 '22 at 01:35

You can do something like this. Use a separate method to gather the date, to avoid repeating similar code.

You can go easy on your users and allow them variations, as long as the entry is unambiguous.

Sub test()
    Const SPROMPT = "Enter the first DOS you'd like to search for:" & vbLf & _
           "(enter in 6-digit ddmmyy format. e.g., 010121)" & vbLf & vbLf & _
           "Enter 'all' to search ALL available AHI data."
    
    Const EPROMPT = "Enter the last DOS you'd like to search for:" & vbLf & _
           "(enter in 6-digit ddmmyy format. e.g., 123121)"
    
    Dim sdate As String, edate As String
    
    sdate = UserDate(SPROMPT, "Date of service begin", "all")
    
    If Len(sdate) = 0 Then
        MsgBox "User canceled or did not enter any data. Macro will end.", , "User canceled"
        Exit Sub
    ElseIf sdate <> "all" Then
        edate = UserDate(EPROMPT, "Date of service end", Format(Date, "ddmmyy"))
        If Len(edate) = 0 Then
            MsgBox "User canceled or did not enter any data. Macro will end.", , "User canceled"
            Exit Sub
        End If
    End If

    Debug.Print "start", sdate
    Debug.Print "end", edate


End Sub

Function UserDate(msg As String, title As String, def As String) As String
    Dim i As Long, dt
    Do
        dt = InputBox(msg, title, def)
        dt = Trim(LCase(dt))      'trim and lower-case
        dt = Replace(dt, "/", "") 'remove any /
        dt = Replace(dt, "-", "") 'remove any -
        If dt = def Or dt Like "######" Then
            UserDate = dt
        ElseIf dt Like "########" Then
            'be nice to your users and just reformat what they gave you...
            UserDate = Left(dt, 4) & Right(dt, 2)
        End If
        If Len(UserDate) > 0 Then Exit Do
        i = i + 1
    Loop While i < 2
End Function

How do I loop an input box one additional time if criteria is not met?

1 Answers1