InputBox 'Cancel' not working

[K1600]

Hi,

I have the following code to search WB2 for data in a date range and place the data from each row into WB1. The issue I am having is if the 'Cancel' button on the 'InputBox' is pressed it just errors and drops me back into the code. I've tried alsorts but can't seem to get round this.

If you enter dates in the two InputBox's then it works perfectly.

Thanks in advance.

Private Sub CmdTest_Click()    'Test Run Report


    Dim wbk1 As Workbook
    Dim sht1 As Worksheet
    Dim wbk2 As Workbook
    Dim sht2 As Worksheet
    Dim startdate As Date, enddate As Date
    Dim rng As Range, destRow As Long
    'Dim shtSrc As Worksheet, shtDest As Worksheet
    Dim c As Range


Application.ScreenUpdating = False    'Stops screen from showing during process


    Set wbk1 = ThisWorkbook
    Set sht1 = wbk1.Sheets("Report Data")
    Set wbk2 = Workbooks.Open("\\GLYNN\Shared\XXXX Returns v.1.0.xlsx", ReadOnly:=True)
    Set sht2 = wbk2.Sheets("XXXX Returns")
    destRow = 2 'start copying to this row


    startdate = CDate(InputBox("Enter Start Date"))
    enddate = CDate(InputBox("Enter End Date"))
    
    'don't scan the entire column...
    Set rng = Application.Intersect(sht2.Range("D:D"), sht2.UsedRange)


    For Each c In rng.Cells
        If c.Value >= startdate And c.Value <= enddate Then
            'Starting one cell to the right of c,
            '  copy a 5-cell wide block to the other sheet,
            '  pasting it in Col H on row destRow
             c.Offset(0, -3).Resize(1, 12).Copy _
                          sht1.Cells(destRow, 1)


            destRow = destRow + 1


        End If
    Next


wbk2.Close savechanges:=False       'Closes Master workbook without saving
Application.ScreenUpdating = True   'Re-enables ScreenUpdating




End Sub

 

[mrshl9898]

What do you want it to do when you press cancel? You can use onerror statement like this.

Sub test()

Dim startdate As String


On Error GoTo presscancel:
 startdate = CDate(InputBox("Enter Start Date"))


 MsgBox startdate
 
Exit Sub


presscancel:
    MsgBox "Cancel Pressed"


End Sub

 

[K1600]

Thanks mrshl9898.

I just want it to close the InputBox if possible and drop back into the UserForm which is still open behind the InputBox and where the command button which initiated the InputBox is located. Hope that makes sense.

Thanks

 

[mrshl9898]

I haven't used userforms much i'm afraid... Does this do the trick?

Private Sub CmdTest_Click()    'Test Run Report



    Dim wbk1 As Workbook
    Dim sht1 As Worksheet
    Dim wbk2 As Workbook
    Dim sht2 As Worksheet
    Dim startdate As Date, enddate As Date
    Dim rng As Range, destRow As Long
    'Dim shtSrc As Worksheet, shtDest As Worksheet
    Dim c As Range




Application.ScreenUpdating = False    'Stops screen from showing during process




    Set wbk1 = ThisWorkbook
    Set sht1 = wbk1.Sheets("Report Data")
    Set wbk2 = Workbooks.Open("\\GLYNN\Shared\XXXX Returns v.1.0.xlsx", ReadOnly:=True)
    Set sht2 = wbk2.Sheets("XXXX Returns")
    destRow = 2 'start copying to this row


On Error GoTo presscancel:
    startdate = CDate(InputBox("Enter Start Date"))
    enddate = CDate(InputBox("Enter End Date"))




    'don't scan the entire column...
    Set rng = Application.Intersect(sht2.Range("D:D"), sht2.UsedRange)




    For Each c In rng.Cells
        If c.Value >= startdate And c.Value <= enddate Then
            'Starting one cell to the right of c,
            '  copy a 5-cell wide block to the other sheet,
            '  pasting it in Col H on row destRow
             c.Offset(0, -3).Resize(1, 12).Copy _
                          sht1.Cells(destRow, 1)




            destRow = destRow + 1




        End If
    Next


presscancel:
wbk2.Close savechanges:=False       'Closes Master workbook without saving
Application.ScreenUpdating = True   'Re-enables ScreenUpdating








End Sub

 

[btorrean]

K1600,

You have to 'trap' the return from the InputBox. I believe that if the InputBox Cancel button is pressed, it returns the text "False". I would separate your single lines of code something like this. For the line

startdate = CDate(InputBox("Enter Start Date"))

you should do something like this:

strStartDate = InputBox("Enter Start Date")
if strStartDate = "False" then Exit Sub
startdate = CDate(strStartDate)

Don't forget to dimension the new variable 'strStartDate' as a String!

I would also recommend that you trap the condition in which a user enters a string that is not a valid date format. But that may be a discussion for another time. Hope this helps!

Brian

 

[K1600]

Thanks both,

I have tried your suggestion Brian and use the following code:

Dim strStartDate As String
    'startdate = CDate(InputBox("Enter Start Date"))
    strStartDate = InputBox("Enter Start Date")
    If strStartDate = "False" Then Exit Sub
    startdate = CDate(strStartDate)
    
Dim strEndDate As String
    'enddate = CDate(InputBox("Enter End Date"))
    strEndDate = InputBox("Enter End Date")
    If strEndDate = "False" Then Exit Sub
    enddate = CDate(strEndDate)

It works fine if dates are entered but if cancel is pressed it errors. If I go through the de-bug its failing on the 'startdate = CDate(strStartDate)' bit. If I remove this the cancel function works spot on but then I have no control over the date entry.


Glynn

 

[StephenCrump]

The Application.InputBox Method returns False (Boolean, not the string "False") if the user cancels.

You're using the InputBox Function, which if the user cancels, return the zero length string "". That's what you need to be testing for.

 

[K1600]

Hi Stephen,

I have tried your suggestion but it still fails??? The code I am using (above) is perfect if a date is entered, it's only when the cancel button is pressed that it errors on the 'startdate = CDate(strStartDate)' and 'enddate = CDate(strEndDate)'.

Just in case it helps, the full code for the sub is below, there are quite a few 'notes' on it at the minute where I have been trying different things but I'msure you'll get the gist:

Private Sub CmdTest_Click()    'Test Run Report


    Dim wbk1 As Workbook
    Dim sht1 As Worksheet
    Dim wbk2 As Workbook
    Dim sht2 As Worksheet
    Dim startdate As Date, enddate As Date
    Dim rng As Range, destRow As Long
    'Dim shtSrc As Worksheet, shtDest As Worksheet
    Dim c As Range


Application.ScreenUpdating = False    'Stops screen from showing during process


    Set wbk1 = ThisWorkbook
    Set sht1 = wbk1.Sheets("Report Data")
    Set wbk2 = Workbooks.Open("\\GLYNN\XXXX Returns v.1.0.xlsx", ReadOnly:=True)
    Set sht2 = wbk2.Sheets("XXXX Returns")
    destRow = 2 'start copying to this row


Dim strStartDate As String
    'startdate = CDate(InputBox("Enter Start Date"))      '*** Original code ***
    strStartDate = InputBox("Enter Start Date")
    'If strStartDate = "" Then Exit Sub      '*** Trial to resolve problem ***
    If strStartDate = "False" Then Exit Sub
    startdate = CDate(strStartDate)      '*** Currently not working ***
    
Dim strEndDate As String
    'enddate = CDate(InputBox("Enter End Date"))      '*** Original code ***
    strEndDate = InputBox("Enter End Date")
    'If strEndDate = "" Then Exit Sub      '*** Trial to resolve problem ***
    If strEndDate = "False" Then Exit Sub
    enddate = CDate(strEndDate)      '*** Currently not working ***


    'don't scan the entire column...
    Set rng = Application.Intersect(sht2.Range("D:D"), sht2.UsedRange)


    For Each c In rng.Cells
        If c.Value >= startdate And c.Value <= enddate Then
            'Starting one cell to the right of c,
            '  copy a 5-cell wide block to the other sheet,
            '  pasting it in Col H on row destRow
             c.Offset(0, -3).Resize(1, 12).Copy _
                          sht1.Cells(destRow, 1)


            destRow = destRow + 1


        End If
    Next


wbk2.Close savechanges:=False       'Closes Master workbook without saving


Application.ScreenUpdating = True   'Re-enables ScreenUpdating


End Sub

 

[StephenCrump]

If the user cancels and the input box returns "", you want to pick this up before trying to convert it to a date.

Here's one way you could do this:

    Do Until IsDate(strStartDate)
        strStartDate = InputBox("Please enter a valid Start Date")
        If strStartDate = "" Then GoTo EndSub   'User has cancelled (or left input field blank)
    Loop
    startdate = CDate(strStartDate)
        
    'Other code
    
EndSub:
    'Do the housekeeping, e.g.
    wbk2.Close savechanges:=False

 

[K1600]

Thanks again Stephen,,

I have entered your code as above but when I run it, I get a "Compile Error: Label not defined" the de-bug is taking me to the 'GoTo EndSub' part of the code. Do I need to do something to define that??

My apologies if I am being a bit slow with this but I am very new to VBA.


Thanks,

Glynn