VBA, InputBox, Run-time error '424': Object required

NathanW

New Member
Joined
Jun 17, 2013
Messages
27
Hey guys,

I'm having an issue with my InputBox command, I have underlined the part that's returning the error.

....
SelectHeading:
On Error Resume Next
'Need to let the user select the proper heading.
Dim rng As Range
Set rng = Nothing
Set rng = Application.InputBox(prompt:="Select the heading you wish to use.", Default:=Cells(4, 2).Value, Type:=8)
If rng = False Then

Resume HeadingNotFound

Else

sHeading = rng.Value

Resume ErrorHandling

End If
.....
If the user hits cancel during the input box part, it returns the Run-time error '424': Object required. No error handling commands have let me get past it. Please please help!!
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Hi And Welcome to The Board

What Actually you want to do with this code can you pls explain in word ?
 
Upvote 0
Thank you very much for your timely response, I will gladly go into more detail.

Essentially, the program I am creating takes data in one worksheet and transfers it to a different worksheet within the same workbook. While it is doing this, it is also sorting it by column under certain headings (matching up the column headings in the first worksheet with the column headings in the second worksheet). If the program can not find the correct heading, it gives the user the ability to select a heading (by selecting a cell on the screen) and then it will list the data in the cells below it. This is where the input box comes into play. The program works perfectly fine if the user selects a cell, but if the user chooses 'cancel', it gives the Run-time error: 424
 
Upvote 0
This avoids your error:

Code:
Sub dural()
    Dim r As Range
    Set r = Nothing
    On Error Resume Next
    Set r = Application.InputBox(Prompt:="Select Range", Type:=8)
    If r Is Nothing Then
        MsgBox "Nothing Selected"
        Set r = Cells(4, 2)
    End If
End Sub
 
Upvote 0
Thank you both very much for you assistance thus far, I really appreciate it! Gary, unfortunately with your code I am still getting the same error =(

I will provide the full code, however, it is rather lengthy, so I apologize in advance for the headaches that may ensue.
...

Sub CopySortPaste()
'This finds the total number of columns and rows used in the spreadsheet
iTotColumns = Sheets("PasteHere").UsedRange.Columns.Count
iTotRows = Sheets("PasteHere").UsedRange.Rows.Count

'This will give the array the dimensions it needs to fit the data
ReDim MyArray(iTotRows, iTotColumns)

'This will begin the for loop which will store the data in a 2 dimensional array
'The first for loop stores the column number
For ColCount = 1 To iTotColumns

'This will begin the nested for loop which cycles through the rows
For RowCount = 1 To iTotRows

'This is storing the data located in each cell in its individual place in the array
MyArray(RowCount, ColCount) = Sheets("PasteHere").Cells(RowCount, ColCount)

Next RowCount
Next ColCount

'This activates the sheet which the data is being transferred to and then selecting the first cell
Sheets("Equipment").Activate
Range("A1").Select

'This finds the total number of rows used in the document we are transferring to. By doing this,
'we can insert the new data at the bottom of the new sheet.
iNewTotRowsUsed = ActiveSheet.UsedRange.Rows.Count

'Because the previous bit of code is usually inaccurate, this Do Until loop has been added
'to make sure that the last cell used in the document (by the computer's standards) is indeed
'the last used cell.
Do Until Cells(iNewTotRowsUsed, 1) <> ""

iNewTotRowsUsed = iNewTotRowsUsed - 1

Loop

'This begins the for loop which will be used to transfer the data from the array to the spreadsheet
For ColCount = 1 To iTotColumns
For RowCount = 1 To iTotRows

'The RowCount variable keeps track of which piece of data to pull from the array
'If RowCount = 1, then it must be the heading and not a piece of equipment
If RowCount = 1 Then

'This will store the heading name in a variable which will be used for searching.
'The goal is to find the heading in the new document and then input the data from
'the array into the spreadsheet below the heading.
sHeading = MyArray(RowCount, ColCount)

'This is the label for when there is an error. Specifically, it is for when the heading
'can not be found when using the find command. If the heading can not be found, it will
'go to the label "HeadingNotFound", which offers to create a new heading.
ErrorHandling:
On Error GoTo HeadingNotFound

'This command will search the document for the heading title. Once it has found it,
'the program will begin to list the data below the heading at the bottom of the table.
Cells.Find(What:=sHeading, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

'iColNumber is a new variable which gets the column number of the active cell, which should be
'the heading which was just searched for.
iColNumber = ActiveCell.Column

'The RowCount variable must be incremented by 1 so that the heading from the array is not
'placed within the document. iRowNumber has been set to the value of the row after the
'very last row which has been used in the document. iNewTotRowsUsed is the variable which
'holds the row number of the last non blank cell in the document being transferred to.
RowCount = RowCount + 1
iRowNumber = iNewTotRowsUsed + 1

'This places the data from the array into the new data sheet
ActiveSheet.Cells(iRowNumber, iColNumber) = MyArray(RowCount, ColCount)

End If

If RowCount > 2 Then

iRowNumber = iRowNumber + 1
ActiveSheet.Cells(iRowNumber, iColNumber) = MyArray(RowCount, ColCount)

End If

Next RowCount
Next ColCount

Exit Sub

'This is where the program runs if the find command could not find the
'heading it was searching for. It will produce a message asking if the
'user would like to sort the data beneath a user-selected column heading.
HeadingNotFound:

Msg = "It appears one of your headings, " & sHeading
Msg = Msg & " could not be found. Would you like "
Msg = Msg & "to choose which heading to put its data under?"
Ans1 = MsgBox(Msg, vbYesNo, "Heading Not Found")

If Ans1 = vbYes Then

On Error GoTo 0

GoTo SelectHeading

Else

GoTo NewColumn

End If

SelectHeading:
'Need to let the user select the proper heading.
Dim rng As Range
Set rng = Nothing
On Error Resume Next
Set rng = Application.InputBox(prompt:="Select the heading you wish to use for " & sHeading & ".", Default:=Cells(4, 2).Value, Type:=8)
If rng Is Nothing Then

Resume HeadingNotFound

Else

sHeading = rng.Value

Resume ErrorHandling

'Else

'Resume HeadingNotFound

End If

NewColumn:
NewMsg = "Would you like to put this data in a new "
NewMsg = NewMsg & "column under the heading " & sHeading & "?"

Ans2 = MsgBox(NewMsg, vbYesNo, "New Column?")

If Ans2 = vbYes Then

Msg = "Please select where you would like to place this heading. "
Msg = Msg & "The column will be placed between the cell you select "
Msg = Msg & "and the cell to its left."

Set rng = Application.InputBox(prompt:=Msg, Type:=8)
iColNumber = rng.Column
ActiveSheet.Cells(4, iColNumber).Activate
ActiveCell.EntireColumn.Insert (xlRight)
Cells(4, iColNumber) = sHeading

Resume ErrorHandling

Else

GoTo DoNothing

End If

DoNothing:
If ColCount <> iTotColumns Then

ColCount = ColCount + 1

sHeading = MyArray(RowCount, ColCount)

Resume ErrorHandling

Else

Exit Sub

End If

End Sub

Hope this helps!!
 
Upvote 0
hi changes in below highlighted Red Color parts
Rich (BB code):
Sub CopySortPaste()
'This finds the total number of columns and rows used in the spreadsheet
iTotColumns = Sheets("PasteHere").UsedRange.Columns.Count
iTotRows = Sheets("PasteHere").UsedRange.Rows.Count

'This will give the array the dimensions it needs to fit the data
ReDim MyArray(iTotRows, iTotColumns)

'This will begin the for loop which will store the data in a 2 dimensional array
'The first for loop stores the column number
For ColCount = 1 To iTotColumns

'This will begin the nested for loop which cycles through the rows
For RowCount = 1 To iTotRows

'This is storing the data located in each cell in its individual place in the array
MyArray(RowCount, ColCount) = Sheets("PasteHere").Cells(RowCount, ColCount)

Next RowCount
Next ColCount

'This activates the sheet which the data is being transferred to and then selecting the first cell
Sheets("Equipment").Activate
Range("A1").Select

'This finds the total number of rows used in the document we are transferring to. By doing this,
'we can insert the new data at the bottom of the new sheet.
iNewTotRowsUsed = ActiveSheet.UsedRange.Rows.Count

'Because the previous bit of code is usually inaccurate, this Do Until loop has been added
'to make sure that the last cell used in the document (by the computer's standards) is indeed
'the last used cell.
Do Until Cells(iNewTotRowsUsed, 1) <> ""

iNewTotRowsUsed = iNewTotRowsUsed - 1

Loop

'This begins the for loop which will be used to transfer the data from the array to the spreadsheet
For ColCount = 1 To iTotColumns
For RowCount = 1 To iTotRows

'The RowCount variable keeps track of which piece of data to pull from the array
'If RowCount = 1, then it must be the heading and not a piece of equipment
If RowCount = 1 Then

'This will store the heading name in a variable which will be used for searching.
'The goal is to find the heading in the new document and then input the data from
'the array into the spreadsheet below the heading.
sHeading = MyArray(RowCount, ColCount)

'This is the label for when there is an error. Specifically, it is for when the heading
'can not be found when using the find command. If the heading can not be found, it will
'go to the label "HeadingNotFound", which offers to create a new heading.
ErrorHandling:
On Error GoTo HeadingNotFound

'This command will search the document for the heading title. Once it has found it,
'the program will begin to list the data below the heading at the bottom of the table.
Cells.Find(What:=sHeading, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

'iColNumber is a new variable which gets the column number of the active cell, which should be
'the heading which was just searched for.
iColNumber = ActiveCell.Column

'The RowCount variable must be incremented by 1 so that the heading from the array is not
'placed within the document. iRowNumber has been set to the value of the row after the
'very last row which has been used in the document. iNewTotRowsUsed is the variable which
'holds the row number of the last non blank cell in the document being transferred to.
RowCount = RowCount + 1
iRowNumber = iNewTotRowsUsed + 1

'This places the data from the array into the new data sheet
ActiveSheet.Cells(iRowNumber, iColNumber) = MyArray(RowCount, ColCount)

End If

If RowCount > 2 Then

iRowNumber = iRowNumber + 1
ActiveSheet.Cells(iRowNumber, iColNumber) = MyArray(RowCount, ColCount)

End If

Next RowCount
Next ColCount

Exit Sub

'This is where the program runs if the find command could not find the
'heading it was searching for. It will produce a message asking if the
'user would like to sort the data beneath a user-selected column heading.
HeadingNotFound:

Msg = "It appears one of your headings, " & sHeading
Msg = Msg & " could not be found. Would you like "
Msg = Msg & "to choose which heading to put its data under?"
Ans1 = MsgBox(Msg, vbYesNo, "Heading Not Found")

If Ans1 = vbYes Then

On Error GoTo 0

GoTo SelectHeading

Else

GoTo NewColumn

End If

SelectHeading:
'Need to let the user select the proper heading.
Dim rng As Variant
Set rng = Nothing
On Error Resume Next
rng = Application.InputBox(prompt:="Select the heading you wish to use for " & sHeading & ".", Default:=Cells(4, 2).Value, Type:=8)
If rng = False Then

Resume HeadingNotFound

Else

sHeading = rng.Value

Resume ErrorHandling

'Else

'Resume HeadingNotFound

End If

NewColumn:
NewMsg = "Would you like to put this data in a new "
NewMsg = NewMsg & "column under the heading " & sHeading & "?"

Ans2 = MsgBox(NewMsg, vbYesNo, "New Column?")

If Ans2 = vbYes Then

Msg = "Please select where you would like to place this heading. "
Msg = Msg & "The column will be placed between the cell you select "
Msg = Msg & "and the cell to its left."

Set rng = Application.InputBox(prompt:=Msg, Type:=8)
iColNumber = rng.Column
ActiveSheet.Cells(4, iColNumber).Activate
ActiveCell.EntireColumn.Insert (xlRight)
Cells(4, iColNumber) = sHeading

Resume ErrorHandling

Else

GoTo DoNothing

End If

DoNothing:
If ColCount <> iTotColumns Then

ColCount = ColCount + 1

sHeading = MyArray(RowCount, ColCount)

Resume ErrorHandling

Else

Exit Sub

End If

End Sub
 
Upvote 0
kevatarvind you are the greatest person that has every lived, THANK YOU SO MUCH!! That has been driving me crazy for days now!
 
Upvote 0
Any way I can avoid the Run-Time Error 424 in this code:

Sub SendEmail_CancelWarning()
Dim OutlookApp As Object
Set OutlookApp = CreateObject("Outlook.Application")
OlSecurityManager.ConnectTo OutlookApp
OlSecurityManager.DisableOOMWarnings = True
On Error GoTo Finally
ActiveWorkbook.SendMail _
Recipients:="abc@email.com", _
Subject:="Subject header" & Format(Date, "dd/mmm/yy")
Finally:
OlSecurityManager.DisableOOMWarnings = False
End Sub


Thanks in advance!!
 
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,954
Members
448,535
Latest member
alrossman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top