How to use an array to find excel columns and move the found columns to another worksheet-CodePudding

I have an array of column headers in an order that I need them to be. I want to use this array to find column headers in an excel worksheet and copy the columns to a new worksheet. One or more of the columns might not exist in the worksheet, so I would like for it to skip that column if it is not found.

Here is what I have so far which works fine if all of the columns are always in the worksheet, however if a column doesn't exist it does not work.

    Option Explicit

Sub MoveCol2() 'Excel VBA to move Columns based on criteria
Dim ar As Variant
Dim i As Integer
Dim j As Long

'Set the Array Values
ar=Array("Sales", "Dept 1", "Dept 8", "Dept 9")

For i=0 To UBound(ar) 'Loop through the Array
j=[A1:S1].Find(ar(i)).Column
Columns(j).Copy Sheet2.Cells(1, i   1) 'Add 1 at end as array starts at 0
Next i
End Sub

Long story short, the goal here is if the column header isn't in the worksheet, then don't throw an error and move on to the next column header in the array.

As always, thank you all in advance for any help you can provide.

CodePudding user response：

I would make a generic procedure that you can call with different parameters, so you can re-use it for similar issues.

Also I would collect all columns with Union first and then copy them at once (this is much faster).

Option Explicit

Public Sub example()
    CopyColumns Array("Sales", "Dept 1", "Dept 8", "Dept 9"), ThisWorkbook.Worksheets("Sheet1"), ThisWorkbook.Worksheets("Sheet2")
End Sub

Public Sub CopyColumns(ByVal ColumnList As Variant, ByVal wsSource As Worksheet, ByVal wsDestination As Worksheet)
    Dim ColumnsToCopy As Range  ' we collect all colums to copy here
    
    Dim ColumnName As Variant
    For Each ColumnName In ColumnList
        Dim FoundAt As Range
        Set FoundAt = Nothing  ' initialize because we are in a loop
        
        Set FoundAt = wsSource.Rows(1).Find(What:=ColumnName, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns)
        
        ' check if column name was found
        If Not FoundAt Is Nothing Then
            If ColumnsToCopy Is Nothing Then
                ' first column found
                Set ColumnsToCopy = FoundAt.EntireColumn
            Else
                ' addinional columns are added with union
                Set ColumnsToCopy = Application.Union(ColumnsToCopy, FoundAt.EntireColumn)
            End If
        End If
    Next ColumnName
    
    ' if colums were found copy them at once
    If Not ColumnsToCopy Is Nothing Then
        ColumnsToCopy.Copy Destination:=wsDestination.Cells(1, 1)
    Else
        MsgBox "No columns were found to copy", vbExclamation
    End If
End Sub

Note that when using the Range.Find method there are some parameters that you should specify otherwise the outcome of find can be randomly work or not. Also you need to check if something was found at all or not (this is the error you run into).

Finally I would call the procedure CopyColumns not Move becaus you copy and don't move! Namings are imporant, if you name your function wrongly you easly end up in hell when using it.

CodePudding user response：

You need to check the result of the find first, otherwise there is no .Column

Sub MoveCol2() 
Dim ar As Variant
Dim i As Integer
Dim j As Long
Dim result As Variant

  ar = Array("Sales", "Dept 1", "Dept 8", "Dept 9")

  For i = 0 To UBound(ar)
    Set result = [A1:S1].Find(ar(i), LookAt:=xlWhole)
    If Not result Is Nothing Then
      j = result.Column
      Columns(j).Copy Sheet2.Cells(1, i   1)
    End If
  Next
End Sub