VBA - Search Column by Specific Name without Text box - vba

Question

I am trying to copy specific columns by the column name and copy it to a new worksheet. I found this code online but I would like to have the cloumn names in the vba code instead of having a textbox pop up and me writing each one in at a time.
Sub copycolumns()
Dim strColRng As String
Dim strSheetName As String
Dim intNoofCols As Integer
Dim strColName() As String
Dim strCurSheetName As String
'To get the No. of Columns Available to Search
intRng = 65
'To get the No. of Columns to copy and paste
intNoofCols = 10
'To set size of the Array
ReDim Preserve strColName(intNoofCols)
For i = 0 To intNoofCols - 1
'To Get the Column Name to Search
strColName(i) = Array(Array("POS", "POS"), Array("Product Code", "Product Code"), Array("Product Name", "Product Name"), Array("Currency", "Currency"), Array("Nominal Source", "Nominal Source"), Array("Maturity Date", "Maturity Date"), Array("Nominal USD", "Nominal USD"), Array("BV Source", "BV Source"), Array("ISIN", "ISIN"), Array("Daily NII USD", "Daily NII USD"))
' InputBox("Enter the Column Name to Copy?", "Column Name")
Next
'To get the Sheet Name to paste the content
strSheetName = InputBox("Enter the Sheet Name to Paste?", "Sheet Name")
'To store the Current Sheet Name where to copy
strCurSheetName = ActiveSheet.Name
For j = 0 To intNoofCols - 1 'To get the Column Names from the Array
For i = 1 To intRng
'To Select the Sheet which column to copy
Sheets(strCurSheetName).Select
'Store the Cell Value
strVal = Cells(1, i)
'Check the Value with the User given column name
If UCase(strVal) = UCase(Trim(strColName(j))) Then
'Select and Copy
Cells(1, i).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Select and Paste
Sheets(strSheetName).Select
Cells(1, j + 1).Select
Range(Selection, Selection.End(xlDown)).PasteSpecial xlPasteValues
' ActiveSheet.Paste
End If
Next
Next
I appreciate any help. Thanks!

Answer 1

So, if I understand correctly, you want the strColName variable to hold the array you defined, instead of the program looping and asking the user to fill the array? In that case, use:
Dim strColName() As String
strColName = Split("POS,Product Code,Product Name,Currency,Nominal Source,Maturity Date,Nominal USD,BV Source,ISIN,Daily NII USD", ",")
Problem is, you defined the strColName as an array of Strings, and you input arrays. Also, you defined the array inside the loop, so it will execute 10 times. You can delete the redim statement, because you define the number of members of the array when you make the array.

Answer 2

I use this all the time
'1 = DELETE all columns IN list
'2 = DELETE all columns NOT in list
'3 = MOVE all columns IN List to NEW Sheet
'4 = MOVE all columns NOT in List to NEW Sheet
'sSource = Source Sheet for Deleting or Moving To
'tTarget = Target Sheet for Moving Columns To
'n = offset the numer of columns when moving columns n = 0 for no offset
Sub MoveOrDelete()
fDeleteOrMove 3, "MySheetNameSoure", "MySheetNameTarget", 0, Array("ColName1", "ColName2", "ColName3")
End Sub
'THIS IS THE FUNCTION FOR MOVE/DELETE
Sub fDeleteOrMove(cWhat As Integer, sSource As String, tTarget As String, n As Integer, myList As Variant)
Dim wsS As Excel.Worksheet
Dim wsT As Excel.Worksheet
Dim LC As Long
Dim mycol As Long
Dim x
ActiveWorkbook.Worksheets(sSource).Select
Set wsS = ActiveWorkbook.Worksheets(sSource) 'Source Sheet for Deleting or Moving To
Set wsT = ActiveWorkbook.Worksheets(tTarget) 'Target Sheet for Moving Columns To
'Get Last Row of "Source" Sheet
LC = wsS.Cells(1, Columns.Count).End(xlToLeft).Column
For mycol = LC To 1 Step -1
x = ""
On Error Resume Next
x = WorksheetFunction.match(Cells(1, mycol), myList, 0)
Select Case cWhat
Case 1
'Delete all columns IN list
If IsNumeric(x) Then wsS.Columns(mycol).EntireColumn.Delete
Case 2
'Delete all columns NOT in list
If Not IsNumeric(x) Then wsS.Columns(mycol).EntireColumn.Delete
Case 3
'Move all columns IN List to NEW Sheet
If IsNumeric(x) Then wsS.Columns(mycol).EntireColumn.Copy _
Destination:=wsT.Columns(x).Offset(, n)
Case 4
'Move all columns NOT in List to NEW SheeT
If Not IsNumeric(x) Then wsS.Columns(mycol).EntireColumn.Copy _
Destination:=wsT.Columns(mycol).Offset(, n)
'Delete the EMPTY columns that were not moved from "Target" sheet
If IsNumeric(x) Then wsS.Columns(mycol).EntireColumn.Copy _
Destination:=wsT.Columns(mycol).Offset(, n).Delete
End Select
Next mycol
ActiveWorkbook.Worksheets(tTarget).Select
End Sub