Copy a column selected by input box to the next available column on an existing sheet

[sungirl2215]

Very new to VAB and I have a workbook with both values and free text survey responses. I'm trying to cut the Free Response Text columns to their own sheet in my workbook. The columns this free text will be in may vary depending on the survey data entered, so I've used the input box to allow the user to select the correct column to be copied.

I understand how to paste that data into specific columns in the new sheet, but this code may be run several times if there are multiple free text columns.

How can I adjust my code to paste to the next available column of the designated sheet? Giving the option to select multiple, non-consecutive columns at once would also work.

Sub CopyFreeText()
    
    Dim MySelection As Range
    
    On Error Resume Next
    Set MySelection = Application.InputBox("Select the column to move.", "Move Column", Type:=8)
    If MySelection Is Nothing Then Exit Sub 'user canceled
    On Error GoTo 0
    
    MySelection.EntireColumn.Cut (Sheets("Free Text Response").Range("A:A"))
    Application.CutCopyMode = False
    
End Sub

 

[dmt32]

Hi,
welcome to forum

untested but see if this update to your code does what you want

Sub CopyFreeText()
    Dim wsPaste     As Worksheet
    Dim NextColumn  As Long
    Dim MySelection As Range, SelectedColumn As Range
    
    On Error Resume Next
    Set MySelection = Application.InputBox("Select the column To move.", "Move Column", Type:=8)
    'user cancelled
    If MySelection Is Nothing Then Exit Sub
    On Error GoTo myerror
    
    Set wsPaste = ThisWorkbook.Worksheets("Free Text Response")
    
    For Each SelectedColumn In MySelection.Areas
        NextColumn = IIf(Len(wsPaste.Cells(1, 1)) = 0, 1, _
                         wsPaste.Cells(1, wsPaste.Columns.Count).End(xlToLeft).Column + 1)
        SelectedColumn.EntireColumn.Cut wsPaste.Cells(1, NextColumn)
        Application.CutCopyMode = False
        i = 1
    Next SelectedColumn
    
myerror:
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
    
End Sub

Hopefully, update should allow multi selection of either contiguous or non-contiguous columns

Dave

 

[sungirl2215]

Hi,
welcome to forum

untested but see if this update to your code does what you want

Sub CopyFreeText()
    Dim wsPaste     As Worksheet
    Dim NextColumn  As Long
    Dim MySelection As Range, SelectedColumn As Range
   
    On Error Resume Next
    Set MySelection = Application.InputBox("Select the column To move.", "Move Column", Type:=8)
    'user cancelled
    If MySelection Is Nothing Then Exit Sub
    On Error GoTo myerror
   
    Set wsPaste = ThisWorkbook.Worksheets("Free Text Response")
   
    For Each SelectedColumn In MySelection.Areas
        NextColumn = IIf(Len(wsPaste.Cells(1, 1)) = 0, 1, _
                         wsPaste.Cells(1, wsPaste.Columns.Count).End(xlToLeft).Column + 1)
        SelectedColumn.EntireColumn.Cut wsPaste.Cells(1, NextColumn)
        Application.CutCopyMode = False
        i = 1
    Next SelectedColumn
   
myerror:
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
   
End Sub

Hopefully, update should allow multi selection of either contiguous or non-contiguous columns

Dave

Thanks for the response Dave! I Tried this 2 ways - both without success.
1. Select 1st column $M:$M and click ok in the input box. This data moved to the correct sheet in to column A. Run again to select 2nd column $F:$F and click ok in the input box. This data moved to the correct sheet and over wrote column A.
2. Select both columns, separated by a comma, $M:$M, $F:$F and click ok in the input box. Only the data from column F moved to the correct sheet in to column A. Both columns were empty from the original sheet.

 

[dmt32]

Hi,
try doing it this way

- display the InputBox & select ONLY the first cell in the Column (M1)
- Hold the Ctrl Key down & then Select cell F1

This should display the Ranges in the InputBox & hopefully, when press OK will transfer to required sheet

Dave

 

[sungirl2215]

Hi,
try doing it this way

- display the InputBox & select ONLY the first cell in the Column (M1)
- Hold the Ctrl Key down & then Select cell F1

This should display the Ranges in the InputBox & hopefully, when press OK will transfer to required sheet

Dave

View attachment 69375

Nope. I still just get column A filled on the new sheet with whatever the last entry in the list was.

 

[dmt32]

Seems to work ok on small sample I tried -Have you copied the code as published or made any changes to it?

Dave

 

[Akuini]

@sungirl2215
Here's another option:

Sub cut_columns1()
  
    Dim rngA As Range
    Dim rngB As Range

    On Error Resume Next
    Set rngA = Application.InputBox("Select the column to move.", "Move Column", Type:=8)
    If rngA Is Nothing Then Exit Sub 'user canceled
    On Error GoTo 0

    rngA.Copy
    With Sheets("Free Text Response")
      
        Set rngB = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
        If Not rngB Is Nothing Then
            .Cells(1, rngB.Column + 1).PasteSpecial xlPasteAll
        Else
            .Range("A1").PasteSpecial xlPasteAll
        End If
    End With
    rngA.Clear

End Sub

basically it works like this:
copy selection (the columns) > paste to target sheet > clear the initial selection

Edit: you need to select the whole column

 

[sungirl2215]

@sungirl2215
Here's another option:

Sub cut_columns1()
 
    Dim rngA As Range
    Dim rngB As Range

    On Error Resume Next
    Set rngA = Application.InputBox("Select the column to move.", "Move Column", Type:=8)
    If rngA Is Nothing Then Exit Sub 'user canceled
    On Error GoTo 0

    rngA.Copy
    With Sheets("Free Text Response")
     
        Set rngB = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
        If Not rngB Is Nothing Then
            .Cells(1, rngB.Column + 1).PasteSpecial xlPasteAll
        Else
            .Range("A1").PasteSpecial xlPasteAll
        End If
    End With
    rngA.Clear

End Sub

basically it works like this:
copy selection (the columns) > paste to target sheet > clear the initial selection

Edit: you need to select the whole column

This did it! Thank you so much!

 

[sungirl2215]

@sungirl2215
Here's another option:

Sub cut_columns1()
 
    Dim rngA As Range
    Dim rngB As Range

    On Error Resume Next
    Set rngA = Application.InputBox("Select the column to move.", "Move Column", Type:=8)
    If rngA Is Nothing Then Exit Sub 'user canceled
    On Error GoTo 0

    rngA.Copy
    With Sheets("Free Text Response")
     
        Set rngB = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
        If Not rngB Is Nothing Then
            .Cells(1, rngB.Column + 1).PasteSpecial xlPasteAll
        Else
            .Range("A1").PasteSpecial xlPasteAll
        End If
    End With
    rngA.Clear

End Sub

basically it works like this:
copy selection (the columns) > paste to target sheet > clear the initial selection

Edit: you need to select the whole column

One more question. The columns copied from are not removed/remaining columns are not moved together with this method. The data has move, but a new column header of "Column#" is inserted. # = the order from which the column was moved to the other sheet. How can I remove those? see image attached.

 

[Akuini]

to remove the copied column, change this:

rngA.Clear

to

rngA.Delete