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

 

[StephenCrump]

I only gave you an outline of the code. You'll need to put in more detail.

The error message just means that you haven't got the "EndSub:" label that I put at the end of my code. This is just an arbitrary name - I have changed it to UserCancelled below just to illustrate. The reason for the GoTo rather than just saying Exit Sub is that you have some housekeeping to do even if the user cancels, e.g. you should close wbk2 rather than leaving it dangling open for the user to have to close (or mess up!) and you also need to turn screen updating back on.

So, in a bit more detail:

Sub YourSub()

    'Declarations
    
    'Initialisation code
   
   'Get Start Date
   Do Until IsDate(strStartDate)
        strStartDate = InputBox("Please enter a valid Start Date")
        If strStartDate = "" Then GoTo UserCancelled   'User has cancelled (or left input field blank)
    Loop
    startdate = CDate(strStartDate)
        
   'Do a similar loop to get End Date
        
    'Code for processing
    
UserCancelled:
    'Do the housekeeping, i.e.
    wbk2.Close savechanges:=False
    Application.ScreenUpdating = True

End Sub

 

[Fluff]

Try

Dim ans1 As String, ans2 As String
Dim startdate As Date, enddate As Date

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

    ans1 = InputBox("Enter Start Date")
    If ans1 = "" Then Exit Sub
    startdate = CDate(ans1)
    ans2 = InputBox("Enter End Date")
    If ans2 = "" Then Exit Sub
    enddate = CDate(ans2)
    
    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

 

[K1600]

Evening both,

Thanks for both your responses, I tried yours (Stephen) but it was still faulting at the same point on the 'startdate = CDate(strStartDate)' line. That said, Fluff's suggestion has done the trick just great.

Thanks again for your help. It's really appreciated.

Glynn

 

[Fluff]

Glad we could help & thanks for the feedback

 

[btorrean]

Had a response here, but I see that I missed the second page of posts. Glad you got it all sorted out!

Brian