Need to get column number from InputBox selection

[NathanW]

Hey guys,

I'm having some trouble with an input box command. I'm creating a program that transfers data from one worksheet to another (within the same workbook) and the data is sorted by column under their respective column headings. For example, the first worksheet may contain a column labeled 'equipment name' with a list of equipment names below it. This program will store the whole column in an array and search for the heading 'equipment name' in the second worksheet, then it will transfer the equipment names to the second worksheet under the heading 'equipment name', which already exists in the new worksheet. However, if it can't find the column heading in the new worksheet, then it should ask the user if they want to insert a new column and use this new column to place the data in (with the appropriate heading). I would like to allow the user to select a cell on the screen at this point, and the column should then be inserted to the left of the cell they choose. Here's my issue, if the user chooses 'cancel' on the inputbox, the "Run-time error '424': Object required" error pops up. Here is my code with the part that gets the error, underlined.

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."

Dim rng2 As Range

Set rng2 = Application.InputBox(prompt:=Msg, Type:=8)

iColNumber = rng2.Column
ActiveSheet.Cells(4, iColNumber).Activate
ActiveCell.EntireColumn.Insert (xlRight)
Cells(4, iColNumber) = sHeading

'sHeading is the name of the column heading

Resume ErrorHandling

I was having the same issue with another input box in my code just the other day and was able to solve it by dimensioning the variable (rng) as a variant, setting it equal to Nothing, then using

rng = Application.InputBox(prompt:="prompt", Type:=8)
If rng = False Then
'Do something
Else
'Do something else
End If

This would be able to solve the issue I am having now, but if I have it dimensioned as a variant, I won't be able to use iColNumber = rng2.Column to get the proper column number. So, the way I see it is I have two options:
1. Figure out how to handle the error I am having now so I don't have to change the way I get the column number, or
2. Redimension rng2 as a variant and figure out a new way to get the column number of the cell the user selects.

There may even be a third option that I dont know about, but I am up for any suggestions!! I hope this wasn't too much of a headache to read and I would appreciate any help I can get!

 

[daverunt]

Does this work?

On Error Resume Next
Set rng2 = Application.InputBox(prompt:=Msg, Type:=8)

If rng2 Is Nothing Then
Exit Sub
End If

 

[NathanW]

Thank you very much daverunt for your response! But unfortunately no, it does not work =( Error handling techniques don't really seem to work on this type of error for some reason.

 

[daverunt]

If the error handling wasn't there I get the "Run-time error '424': Object required" error. With it there it forces the code to evaluate the next line?

I note you have Resume error handling lower in the code. Is that screwing it up? You need to turn it on for that bit of code

 

[kevatarvind]

try like below

Sub Test()
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."
Dim rng2 As Variant
rng2 = Application.InputBox(prompt:=Msg, Type:=8)
If rng2 = False Then
Exit Sub
Else
iColNumber = rng2
ActiveSheet.Cells(4, iColNumber).Activate
ActiveCell.EntireColumn.Insert (xlRight)
Cells(4, iColNumber) = sHeading
End If
End Sub

 

[NathanW]

kevatarvind, this is the second day in a row now you have come to save my butt! That got rid of the error when I hit 'cancel' during the 'insert new column' part, but now it gives the error 'Run-time error '13': Type mismatch' at the line iColNumber = rng2. I have iColNumber dimensioned as an integer. I'm assuming there lies the error? Is there another way to get the column number from rng2?

Daverunt, not sure why but the "On Error Resume Next" does not force my program to do anything, it still stops the program at that line. And the Resume ErrorHandling is just referring to a labeled section within my code, telling it to go back to that part of my code, it is not something that is turned 'on' or 'off'.

Thank you so much guys!

 

[kevatarvind]

i have checked in my file code working perfect but if you facing problem then pls post your full code and use code tag to post your code see below remove the extra space after the c

you code here 
[/c ode]

 

[NathanW]

Ah, perhaps I should have specified better, the program works fine if I am choosing 'cancel' when going to insert a new column, but if I do choose to insert a new column and I select a cell on the screen and press ok in the input box, this is when the error is produced. Regardless, I shall post my full code.

'Variables used in CopySortPaste()
Dim Msg As String 
Dim sHeading As String
Dim NewMsg As String
Dim iRowNumber As Integer
Dim iColNumber As Integer
Dim Ans1 As Integer 
Dim Ans2 As Integer
Dim iTotColumns As Integer  
Dim iTotRows As Integer    
Dim i As Integer
Dim ColCount As Integer
Dim RowCount As Integer
Dim iNewTotRowsUsed As Integer
Dim MyArray() As Variant
Dim rng As Variant
Dim rng2 As Variant

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
    
    'These two loops will find the absolute last nonblank columns and rows (respectively)
    Do Until Cells(3, iTotColumns) <> ""
        
    iTotColumns = iTotColumns - 1
        
    Loop
    
    Do Until Cells(iTotRows, 2) <> ""
        
    iTotRows = iTotRows - 1
        
    Loop
    
    '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 = 2 To iTotColumns
    
        'This will begin the nested for loop which cycles through the rows
        For RowCount = 3 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 = 2 To iTotColumns
        For RowCount = 3 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 = 3 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 > 4 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 choose a heading to insert the data under.
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 the user selects 'yes', then the program will ask the user
    'to select a heading.
    If Ans1 = vbYes Then
    
        Set rng = Nothing
        rng = Application.InputBox(prompt:="Select the heading you wish to use for " & sHeading & ".", Default:=Cells(4, 2).Value, Type:=8)
        
        'This statement is for if the user selects 'cancel'. In that case,
        'the program will go back to the previous question.
        If rng = False Then
    
        GoTo HeadingNotFound
    
        Else
        
        sHeading = rng
    
        Resume ErrorHandling
        
        End If
    
    Else
    
    'If the user selects 'No' to choosing a heading, then it will ask
    'if they would like to put the data in a new column with the proper heading.
    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
        
        'If the user has selected 'yes', then the program will ask the user to
        'select the cell where they would like to enter a new column.
        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."
        
        '*************************************************************************
        'This is where I am running into an error.
        '*************************************************************************
        
        rng2 = Application.InputBox(prompt:=Msg, Type:=8)
        
        If rng2 = False Then Resume HeadingNotFound
        
        iColNumber = rng2
        ActiveSheet.Cells(4, iColNumber).Activate
        ActiveCell.EntireColumn.Insert (xlRight)
        Cells(4, iColNumber) = sHeading
        
        Resume ErrorHandling
        
        'If the user has selected 'no', then the program will check to see
        'if it is the last column heading in the array. If it is not the last
        'heading, then it will increment the counter, obtain the next column
        'heading to search for, and then return to the search command. If it
        'is the last heading, then it will exit the sub.
        Else
            If ColCount <> iTotColumns Then
        
            ColCount = ColCount + 1
            sHeading = MyArray(RowCount, ColCount)
    
            Resume ErrorHandling
    
            Else
        
            Exit Sub
    
            End If
    
        End If
        
    End If

End Sub

Thanks again!

 

[NathanW]

I figured it out! I made the following change:

rng2 = Application.InputBox(prompt:=Msg, Type:=8).Column

And that did the trick! Thank you very much for your time and assistance guys!

 

[NathanW]

I spoke too soon... that returned the 424 error again when I hit 'cancel'.... ='( so ignore that last statement I made, lol