Selecting an entire column through inputbox by inputting a number

[haris1]

Hello,

Is it possible to select an entire column through inputbox vba by inputing a number, for example if we input 1 in input box it should copy columnn A , if 2 then column B and so on.

Thanks,
Hari

 

[mumps]

Try:

Sub SelectCol()
    Dim response As Long
    response = InputBox("Please enter the column number of the column to hide.")
    ActiveSheet.Columns.Hidden = False
    Columns(response).EntireColumn.Hidden = True
End Sub

 

[haris1]

Thanks Mumps, Just to confirm will i be able to copy this selcted column as well from here. Also i am not trying to hide any column. i just want to select the entire columns and then paste it to next sheet.

 

[mumps]

Where in the next sheet do you want to paste it?

 

[haris1]

in sheet 2 from row 2

 

[MARK858]

You can't paste an entire column into row 2, it wouldn't fit.

 

[haris1]

Oh yes.. In that case first 10000 row would do.

 

[mumps]

I'm still not sure exactly what you want to do. Do you want to copy the contents of the column and paste it horizontally across row 2 of Sheet2? If this is the case, what would be the maximum number of rows containing data in the copied column? Or do you want to paste the column vertically in Sheet2 and if so, where?

 

[haris1]

first of all, thank you so much for looking into this. I was able to write below code, which does work in part-
Sub InsertShape()

Dim Rng As Range
Dim Parange As Range
Dim xsht As Worksheet, ysht As Worksheet
Set xsht = Sheets("Sheet1")
Set ysht = Sheets("Sheet2")
ysht.Range("A2:Z" & Rows.Count).Clear

'copy Tickers
Set Rng = Application.InputBox("Please Select Range For Ticker", Type:=8)
With Rng
Set Prange = ysht.Range("A2")
If Rng Is Nothing Then
MsgBox "Operation Cancelled"
Else
Rng.Copy
Prange.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
End With

'copy CUSIPS
Set Rng = Application.InputBox("Please Select Range For CUSIPS", Type:=8)
With Rng
Set Prange = ysht.Range("A2")
If Rng Is Nothing Then
MsgBox "Operation Cancelled"
Else
Rng.Copy
Prange.Offset(0, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
End With


I am facing some problem with this-

1. In spite of copying the full column, please help me to adjust it to copy first 5000 cells only.
2. When i click on "cancel" button on input box dialog without inputting any value, it copies data as per the last selected option. Please help me to fix it so that if i cancel the dialog box, it would not copy any data as per last selected option and move to next.


Again, thanks so much for looking into this

 

[mumps]

Try this macro. Change all occurrences of '5000' to suit your needs.

Sub InsertShape()
    Dim Rng As Range
    Dim Prange As Range
    Dim xsht As Worksheet, ysht As Worksheet
    Set xsht = Sheets("Sheet1")
    Set ysht = Sheets("Sheet2")
    ysht.Range("A2:Z" & Rows.Count).Clear
    Set Prange = ysht.Range("A2")
    Application.DisplayAlerts = False
    On Error Resume Next
    Do
        Set Rng = Application.InputBox("Please Select Range of 5 Rows For Ticker", Type:=8)
        If Not Rng Is Nothing Then
            If Rng.Count = 5 Then
                Rng.Copy
                Prange.PasteSpecial xlPasteValues
                Application.CutCopyMode = False
                Exit Do
            ElseIf Rng.Count < 5 Then
                MsgBox "You must select 5 rows.", vbOKOnly
            End If
        ElseIf Rng Is Nothing Then
            ysht.Cells.ClearContents
            Exit Sub
        End If
    Loop
    Set Rng = Nothing
    Do
        Set Rng = Application.InputBox("Please Select Range of 5 Rows For CUSIPS", Type:=8)
        If Not Rng Is Nothing Then
            If Rng.Count = 5 Then
                Rng.Copy
                Prange.Offset(0, 1).PasteSpecial xlPasteValues
                Application.CutCopyMode = False
                Exit Do
            ElseIf Rng.Count < 5 Then
                MsgBox "You must select 5 rows.", vbOKOnly
            End If
        ElseIf Rng Is Nothing Then
            ysht.Cells.ClearContents
            Exit Sub
        End If
    Loop
    On Error GoTo 0
    Application.DisplayAlerts = True
End Sub