Application.InputBox error 424 on cancel

Question

I'm working with a sub which calls an input box to copy selected cells from a sheet and paste them into a multicolumn listbox. I've finally got everything working correctly, except the error 424 when the user cancels the inputbox. I've read through countless help threads regarding this error and have found nothing that seems to be able to handle the error for me. I'm hoping that someone out there can tell me if something is wrong with the code below (aside from 12 million exit sub attempts to stop the error), or possibly give me an idea of another area (Declarations, Initialization, Activate?) that I should be checking. Any ideas are appreciated, thanks.

Private Sub CopyItemsBtn_Click()
Dim x As Integer
Dim rSelected As Range, c As Range
Dim wb
Dim lrows As Long, lcols As Long
x = ProformaToolForm.ItemsLB.ListCount

'Prompt user to select cells for formula
On Error GoTo cleanup
wb = Application.GetOpenFilename(filefilter:="Excel Files,*.xl*;*.xm*")
If wb <> False Then
    Workbooks.Open wb
End If

Set rSelected = Application.InputBox(Prompt:= _
                "Select cells to copy", _
                Title:="Transfer Selection", Type:=8)
If Err.Number = 424 Then
    Debug.Print "Canceled"
    Exit Sub
ElseIf Err.Number <> 0 Then
    Debug.Print "unexpected error"
    Exit Sub
End If

If rSelected.Rows.Count < 1 Or rSelected.Columns.Count < 1 Then
    Exit Sub
End If
Err.Clear
On Error GoTo 0

'Only run if cells were selected and cancel button was not pressed
If Not rSelected Is Nothing Then
    For Each c In rSelected
        With ProformaToolForm.ItemsLB
            .AddItem
            .List = rSelected.Cells.Value
        End With
    Next
Else
    Exit Sub
End If
cleanup: Exit Sub
End Sub

After some cleanup, here's my attempt with Tim's code:

Private Sub CopyItemsBtn_Click()
Dim rSelected As Range, c As Range
Dim wb

wb = Application.GetOpenFilename(filefilter:="Excel Files,*.xl*;*.xm*")

If wb <> False Then
    Workbooks.Open wb
End If

'Prompt user to select cells for formula
On Error Resume Next
Set rSelected = Application.InputBox(Prompt:= _
                "Select cells to copy", _
                Title:="Transfer Selection", Type:=8)
On Error GoTo 0

If rSelected Is Nothing Then
    MsgBox "no range selected", vbCritical
    Exit Sub
End If

For Each c In rSelected
    With ProformaToolForm.ItemsLB
        .AddItem
        .List = rSelected.Cells.Value
    End With
Next

End Sub

If there's an error your code will jump directly to `cleanup` and exit, so your tests following the `InputBox` will never execute... — Tim Williams, Jun 03 '16 at 16:36
in other words if you still want to execute those test on errors thrown by `InputBox` then you should 1: place `On Error Resume Next` statement right before `Set rSelected = ...` and another `On Error GoTo cleanup` statement right after the last `End If` of your `If-Then-ElseIf-End If` error checking block. But what errors other than "424" are you expecting? — user3598756, Jun 03 '16 at 16:54
I had the Resume Next in place at one point, changing it to GoTo was just one of many attempts to solve the problem. I removed the bit of code involving catching other errors (yet another attempt to find the problem). — dubyarly, Jun 03 '16 at 17:08
"Not working" looks like what, exactly? Have you tried just `ProformaToolForm.ItemsLB.List = rSelected.Value` ? — Tim Williams, Jun 03 '16 at 17:20
It's the same thing every time, Error 424 with `Set rSelected = Application.InputBox(Prompt:= _ "Select cells to copy", _ Title:="Transfer Selection", Type:=8)` highlighted (rSelected = Nothing). — dubyarly, Jun 03 '16 at 17:23
Tried replacing my `For Each` loop with your line and still receive 424 on cancel, again highlighting `Set rSelected...` Getting rid of the loop is a nice touch though, thank you. — dubyarly, Jun 03 '16 at 17:27

score 2 · Answer 1 · answered Jun 03 '16 at 16:40

2

Here's how I'd tend to do this:

Private Sub CopyItemsBtn_Click()

    Dim rSelected As Range

    On Error Resume Next
    Set rSelected = Application.InputBox(Prompt:= _
                "Select cells to copy", _
                Title:="Transfer Selection", Type:=8)
    On Error GoTo 0

    If rSelected Is Nothing Then
        MsgBox "no range selected!", vbCritical
        Exit Sub
    End If

    'continue with rSelected

End Sub

answered Jun 03 '16 at 16:40

Tim Williams

154,628
8
97
125

Tried it, still not working. I also cleaned up some of the code (had some declarations and whatnot left from previous attempts at coding the rest of the sub). Adding it to the OP. – dubyarly Jun 03 '16 at 17:01
I do appreciate the help, your answer is the same or similar to everything else I've found and it seems to be sound advice - it's just that for whatever reason my code is failing anyway. I think I read somewhere about InputBoxes which deal with Ranges specifically are prone to errors like this so I'm going to try to dig deeper on that, but if you (or anyone else) has some info to add to that I'd be grateful. – dubyarly Jun 03 '16 at 17:22

score 0 · Answer 2 · edited May 23 '17 at 10:34

Found a solution, from Dirk's final post here. For anyone interested, here is the working code:

Private Sub CopyItemsBtn_Click()
Dim rSelected As Range
Dim wb
Dim MyCol As New Collection

wb = Application.GetOpenFilename(filefilter:="Excel Files,*.xl*;*.xm*")

If wb <> False Then
    Workbooks.Open wb
End If

MyCol.Add Application.InputBox(Prompt:= _
            "Select cells to copy", _
            Title:="Transfer Selection", Type:=8)

If TypeOf MyCol(1) Is Range Then Set MyRange = MyCol(1)
Set MyCol = New Collection
If rSelected Is Nothing Then
    MsgBox "no range selected", vbCritical
    Exit Sub
End If

ProformaToolForm.ItemsLB.List = rSelected.Value
End Sub

Application.InputBox error 424 on cancel

2 Answers2