'How do I loop an input box one additional time if criteria is not met?
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
Solution 1:[1]
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
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 | Tim Williams |