InputBox problem

[liampog]

Hi there

I'm having problems with InputBox returning a runtime error 13 when OK is clicked with no data entered in the input box or if Cancel is clicked.

This is my code:

        Dim datetoday As Long
        datetoday = MsgBox(prompt:="Is this break list for today? " & Date, Buttons:=vbYesNo)
        If datetoday = vbNo Then
            Dim manualdateentry As Date
            manualdateentry = InputBox("Please enter the date for this break list (DD/MM/YY):", "Manual Date Entry", Date)
            Range("AB2").Value = manualdateentry
        Else: Range("AB2").Value = Date
        End If

Can anyone suggest making this work?

Basically, if no data is entered and the user clicks OK, I want it to ask again and if the user clicks Cancel, I want the Sub to exit.

Thanks in advance for any and all help....

 

[Tom Urtis]

See if this gets you any closer to what you want:

Sub InputBoxExample1()
Dim datetoday As Long
datetoday = MsgBox(prompt:="Is this break list for today? " & Date, Buttons:=vbYesNo)
If datetoday = vbNo Then
Dim manualdateentry As String
showInputBox:
manualdateentry = InputBox("Please enter the date for this break list (DD/MM/YY):", "Manual Date Entry", Date)
Select Case True
Case StrPtr(manualdateentry) = 0
MsgBox "You hit Cancel.", 48, "Entry cancelled."
Exit Sub
Case Len(manualdateentry) = 0
MsgBox "You hit OK but entered nothing.", 48, "Try again."
GoTo showInputBox
Case Else
If IsDate(manualdateentry) = True Then
Range("AB2").Value = manualdateentry
Else
MsgBox "You did not enter a valid date.", 48, "Must enter a date."
GoTo showInputBox
End If
End Select
End If
End Sub

 

[liampog]

Hi Tom

This works perfectly, however, when entering the date it enters it into the AB2 cell as American format - entering 1/3/11 sets AB2 to Monday 03 January 2011.

I think this is because manualdateentry is defined as String, rather than Date.

From what I am constantly learning by using these forums and experimenting myself, I've tried to rectify this and it appears to work. Can anyone just check the code I've added and tell me if it's technically correct? I know it works, but is this the correct way to solve this problem?:

Dim manualdateentry As String
            
ShowInputBox:

            manualdateentry = InputBox("Please enter the date for this break list (DD/MM/YY):", "Manual Date Entry")
            Select Case True
                Case StrPtr(manualdateentry) = 0
                Exit Sub
                Case Len(manualdateentry) = 0
                GoTo ShowInputBox
                Case Else
                If IsDate(manualdateentry) = True Then
                    [COLOR="Red"]Dim entereddate As Date
                    entereddate = manualdateentry[/COLOR]
                    ActiveSheet.Unprotect
                    Range("AB2").Value = [COLOR="red"]entereddate[/COLOR]
                    GoTo StartPrint
                Else
                GoTo ShowInputBox
                End If
            End Select
        Else: Range("AB2").Value = Date
        End If

 

[Tom Urtis]

In my opinion, InputBoxes are the worst method for entering dates. There is too much chance for ambiguity due to how dates "should" look based on cultural familiarity and various country settings.

Sometimes, more code is better than less code, if it means a way can be established for a user to select a month name, a day, and a year, all in separate fields, and now you know that the user has selected the date they have in mind. You can assign a Public variable to that date and format it to represent any appearance you want. It's how I make sure, when I design projects involving dates, that everyone is on the same page.

Please just try this code in a new fresh workbook, and if it does what you want, I suggest you consider using it. You have some other action going on there with the StartPrint notation, I do not know if that is a macro or some other code so it is not included here.

So, open a new workbook and save it. If you are using Excel 2007 or 2010, be sure to save it as .xlsm.

Next, find your workbook module.

If you are using versions 2003 or before:
Find the little Excel workbook icon near the upper left corner of your workbook window, usually just to the immediate left of the File menu option. Right click on that icon, and left click to select View Code.

If you are using versions 2007 or 2010:
From your worksheet press Alt+F11, then press Ctrl+R, find your workbook name in the "Project - VBAProject" window. Expand the Microsoft Excel Object folder for your workbook, right click on ThisWorkbook and left click to select View Code.

Paste the following procedures into the large white area that is the workbook module:

Private Sub Workbook_Open()
Run "DeleteDateSelector"
End Sub
 
Private Sub Workbook_Activate()
Run "DeleteDateSelector"
End Sub
 
Private Sub Workbook_Deactivate()
Run "DeleteDateSelector"
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Run "DeleteDateSelector"
ThisWorkbook.Save
End Sub

While you are in the VBE, from the menu bar, click Insert > Module and paste in all the below code. Yes there is a lot of code here, make sure you select is all and copy it all, then paste it into the new module. All means all...make sure you also copy the bottom macro named DeleteDateSelector, AND the statement at the top of the module Public myDate As Date.

After that, press Alt+Q to return to the worksheet, hit Alt+F8 and run the macro named DateSelector.

Public myDate As Date
 

Sub DateSelector()
Range("AB2").NumberFormat = "DDDD DD MMMM YYYY"

Dim datetoday%
datetoday = MsgBox("Is this break list for today, " & Format(VBA.Date, "DDDD DD MMMM YYYY") & "?", 36, "Please confirm:")
If datetoday = 6 Then
Range("AB2").Value = VBA.Date
Columns(28).AutoFit
Exit Sub
End If

Dim dlgDate As DialogSheet, DateDialog$
Dim i%, strYear$, strMonth$, blnLeapYear As Boolean
DateDialog = "DateSelector"

Application.ScreenUpdating = False

On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(DateDialog).Delete
Application.DisplayAlerts = True
Err.Clear
    
Set dlgDate = ActiveWorkbook.DialogSheets.Add
With dlgDate
.Name = DateDialog
.Visible = xlSheetHidden

With .DialogFrame
.Height = 196
.Width = 252
.Caption = "Select a date"
End With

.Labels.Add 90, 50, 26, 16
.Labels(1).Caption = "Year"

.Labels.Add 160, 50, 30, 16
.Labels(2).Caption = "Month"

.Labels.Add 251, 50, 20, 16
.Labels(3).Caption = "Day"

.DropDowns.Add 90, 64, 48, 16
With .DropDowns(1)
      For i = -10 To 10
      .AddItem Format(DateSerial(Year(Date) + i, 1, 1), "YYYY")
      Next i
     .ListIndex = 11
End With

.DropDowns.Add 160, 64, 70, 16
With .DropDowns(2)
      For i = 1 To 12
      .AddItem Format(DateSerial(1, i, 1), "MMMM")
      Next i
     .ListIndex = Format(Date, "M")
End With

.DropDowns.Add 251, 64, 48, 16
With .DropDowns(3)
      For i = 1 To 31
      .AddItem i
      Next i
     .ListIndex = Format(Date, "D")
End With

With .Buttons("Button 2")
.BringToFront
.Left = 90
.Top = 180
.Width = 140
.Height = 20
.Caption = "Yes, select this date"
End With

With .Buttons("Button 3")
.BringToFront
.Left = 251
.Top = 180
.Width = 48
.Height = 20
.Caption = "Cancel"
End With

Application.ScreenUpdating = True
       
If .Show = True Then

With .DropDowns(1)
strYear = .List(.ListIndex)
End With

With .DropDowns(2)
strMonth = .List(.ListIndex)
End With

If .DropDowns(3).ListIndex = 31 Then
Select Case strMonth
Case "April", "June", "September", "November"
MsgBox "There is no such date as " & strMonth & " " & .DropDowns(3).ListIndex & "." & vbCrLf & _
"Please select a valid date.", 48, strMonth & " only has 30 days."
.Show
End Select
End If

If strMonth = "February" Then
blnLeapYear = IIf(Month(DateSerial(Val(strYear), 2, 29)) = 2, True, False)

If blnLeapYear = False Then
If .DropDowns(3).ListIndex > 28 Then
MsgBox "There is no such date as " & strMonth & " " & .DropDowns(3).ListIndex & "." & vbCrLf & _
"Please select a valid date.", 48, strMonth & " only has 28 days in " & strYear
.Show
End If

Else

If .DropDowns(3).ListIndex > 29 Then
MsgBox "There is no such date as " & strMonth & " " & .DropDowns(3).ListIndex & "." & vbCrLf & _
"Please select a valid date.", 48, strMonth & " only has 29 days in " & strYear
.Show
End If

End If
End If

myDate = DateSerial(.DropDowns(1).List(.DropDowns(1).ListIndex), .DropDowns(2).Value, .DropDowns(3).Value)

If Val(Format(myDate, "DD")) = Val(.DropDowns(3).Value) Then
MsgBox _
"You selected the date of " & Format(myDate, "DDDD DD MMMM YYYY") & "." & vbCrLf & _
"Click OK and it will be entered into cell AB2.", 64, "Confirm date selection"
Range("AB2").Value = myDate
Columns(28).AutoFit

Else
MsgBox "That was 2 attempts at selecting an invalid date." & vbCrLf & "Click OK to exit.", 16, "Cannot continue."
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
Exit Sub
End If

Else

MsgBox "No date was selected.", 64, "You clicked Cancel."

End If

Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
    
End With
End Sub
 
 
Private Sub DeleteDateSelector()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
On Error Resume Next
DialogSheets("DateSelector").Delete
Err.Clear
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub

 

[liampog]

Hi Tom

Great solution, very pretty too.

I'm trying my best to try to learn how this works, but it's proving difficult because a lot of all of this code is new to me.

Rather than the user manually setting all the elements of the date... would it be possible to just have one dropdown list of the next 14 days of dates after today's date?

Liam

 

[Tom Urtis]

Yes, you can have one drop down list that is populated with the next 14 days.

Keep all the original code in the workbook module.

Keep the original Public mydate as Date statement at the top of the standard module.

Keep the original macro named DeleteDateSelector.

Replace the original DateSelector macro with the one below:

Sub DateSelector()
Range("AB2").NumberFormat = "DDDD DD MMMM YYYY"

Dim datetoday%
datetoday = MsgBox("Is this break list for today, " & Format(VBA.Date, "DDDD DD MMMM YYYY") & "?", 36, "Please confirm:")
If datetoday = 6 Then
Range("AB2").Value = VBA.Date
Columns(28).AutoFit
Exit Sub
End If

Dim dlgDate As DialogSheet, DateDialog$, i%, intItem%
DateDialog = "DateSelector"

Application.ScreenUpdating = False

On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(DateDialog).Delete
Application.DisplayAlerts = True
Err.Clear
    
    
Set dlgDate = ActiveWorkbook.DialogSheets.Add
With dlgDate
.Name = DateDialog
.Visible = xlSheetHidden

With .DialogFrame
.Height = 196
.Width = 186
.Caption = "Select a date"
End With

.Labels.Add 90, 50, 140, 16
.Labels(1).Caption = "Dates for the next 14 days:"

.DropDowns.Add 90, 64, 140, 16
With .DropDowns(1)
For i = 1 To 14
.AddItem Format(DateSerial(Year(Date), Month(Date), Day(Date) + i), "DDDD DD MMMM YYYY")
Next i
.ListIndex = 1
End With

With .Buttons("Button 2")
.BringToFront
.Left = 90
.Top = 180
.Width = 86
.Height = 20
.Caption = "Select this date"
End With

With .Buttons("Button 3")
.BringToFront
.Left = 186
.Top = 180
.Width = 46
.Height = 20
.Caption = "Cancel"
End With

Application.ScreenUpdating = True
       
If .Show = True Then

intItem = .DropDowns(1).ListIndex
myDate = DateSerial(Year(Date), Month(Date), Day(Date) + intItem)

MsgBox _
"You selected the date of " & Format(myDate, "DDDD DD MMMM YYYY") & "." & vbCrLf & _
"Click OK and it will be entered into cell AB2.", 64, "Confirm date selection"
Range("AB2").Value = myDate
Columns(28).AutoFit

Else

MsgBox "No date was selected.", 64, "You clicked Cancel."

End If

Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
    
End With
End Sub