VBA Copying data from one table to another and rearranging columns

Question

I have 99 columns in one table called tbl_raw. I need to copy 96 of those columns into another table with the same exact header names, but they are rearranged in a different order. What is the most efficient way to do this?

The only way I knew was:

raw_data.Range("tbl_raw[EMPLOYEE]").Copy processed_data.Range("tbl_processed[EMPLOYEE]").PasteSpecial

However, this would take a lot of code (96 * 2 = 192 lines) and I wasn't sure if there was a more efficient way to do it.

I tried to use https://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tables, but I couldn't figure out a way to do it with that information either.

Any guidance would be greatly appreciated.

Answer 1

I needed a generalized version to copy multiple tables. If anyone needs the code here it is (based on user11198948's answer).

Private Sub CopyTable(SourceTbl As ListObject, TargetTbl As ListObject)
Dim lc As Long, mc As Variant, x As Variant

With TargetTbl
    ' Clear target table
    On Error Resume Next
    .DataBodyRange.Clear
    .Resize .Range.Resize(SourceTbl.ListRows.Count + 1, .ListColumns.Count)
    On Error GoTo 0
    '   Loop through target header and collect columns from source table
    For lc = 1 To .ListColumns.Count
        mc = Application.Match(.HeaderRowRange(lc), SourceTbl.HeaderRowRange, 0)
        If Not IsError(mc) Then
            x = SourceTbl.ListColumns(mc).DataBodyRange.Value
            .ListColumns(lc).DataBodyRange.Value = x
        End If
    Next lc
End With
End Sub

Answer 2

ForEach/For are the magic of working with arrays and collections. There are ways to make the following code more efficient, but I think that may get in the way of understanding what is happening. It has been about 6 months or so since I last worked with VBA, but I believe this should work. I suggest stepping through and watching your locals to see what is going on. If there are issues with variable assignments, there might need to be a 'Let' changed to a 'Set'. Code follows:

'// PROBLEM:
'// Copy data from one list to a second list.
'// Both lists have the same column names and the same number of columns.
'// Copy data based on the column name.

'// Modify to return a custom source-destination association.
Private Function GetColumnTranslations(zLeftColumns As ListColumns, zRightColumns As ListColumns) As Variant
  Dim zReturn(,) As Variant
  ReDim zReturn(0 To zLeftColumns.Count As Long, 0 To 1 As Long)
  Dim zReturnOffset As Long '// Specifies what index we are working at during our ForEach interations.  

  Dim zLeftVar As Variant
  Dim zRightVar As Variant

  ForEach zLeftVar in zLeftColumns
    '// Go through each 'left' column to Find the first 'right' column that matches the name of the 'left' column.
    '// Only the first 'right' column with a matching name will be used. Issue is solved with another ForEach, but beyond forum question's scope.
    ForEach zRightVar in zRightColumns

      If zLeftVar.Name = zRightVar.Name Then

        '// Store the association and exit the nested ForEach.
        Let zReturn(zReturnOffset, 0) = zLeftVar.Range.Column '// Source.
        Let zReturn(zReturnOffset, 1) = zRightVar.Range.Column '// Destination.
        Let zReturnOffset = zReturnOffset + 1

        Exit ForEach
      End If
    Next zRightVar
  Next zLeftVar

  '// Assign return value.
  Let GetColumnTranslations = zReturn
End Function


'// Take each source row and copy the value to a new destination row.
'// New rows are added to the end of the destination list.
Public Sub CopyList(zSourceList As ListObject, zDestinationList As ListObject)
  Dim zColumnTranslations As Variant '// Will be 2-dimensional array.
  Dim zTranslationVar As Variant '// Will be array of 2 elements. 
  Let zColumnTranslations = GetColumnTranslations(zSourceList.Columns, zDestinationList.Columns)

  Dim zSourceRowVar As Variant '// Will translate to Range.
  Dim zDestinationRow As Range

  '// Every source row needs copied to a new row in destination.
  ForEach zSourceRowVar in zSourceList.Rows
    Set zDestinationRow = zDestinationList.Rows.Add.Range

    ForEach zTranslationVar in zColumnTranslations
      '// Value may copy formula.
      Let zDestinationRow(0,zTranslationVar(1)).Value = zSourceRowVar(0,zTranslationVar(0)).Value
    Next zTranslationVar
  Next zSourceRowVar
End Sub

Answer 3

Avoid dealing with copying ListObject columns and use a direct value transfer.

Option Explicit

Sub raw2processed()

    Dim lc As Long, mc As Variant, x As Variant
    Dim raw_data As Worksheet, processed_data As Worksheet
    Dim raw_tbl As ListObject, processed_tbl As ListObject

    Set raw_data = Worksheets("raw")
    Set processed_data = Worksheets("processed")
    Set raw_tbl = raw_data.ListObjects("tbl_raw")
    Set processed_tbl = processed_data.ListObjects("tbl_processed")

    With processed_tbl
        'clear target table
        On Error Resume Next
        .DataBodyRange.Clear
        .Resize .Range.Resize(raw_tbl.ListRows.Count + 1, .ListColumns.Count)
        On Error GoTo 0

        'loop through target header and collect columns from raw_tbl
        For lc = 1 To .ListColumns.Count
            Debug.Print .HeaderRowRange(lc)
            mc = Application.Match(.HeaderRowRange(lc), raw_tbl.HeaderRowRange, 0)
            If Not IsError(mc) Then
                x = raw_tbl.ListColumns(mc).DataBodyRange.Value
                .ListColumns(lc).DataBodyRange = x
            End If
        Next lc

    End With

End Sub

Answer 4

Here's a basic example of copying over all but some columns from one table to another:

Dim tbl1 As ListObject, tbl2 As ListObject
Dim h As ListColumn

Set tbl1 = ActiveSheet.ListObjects("Table1")
Set tbl2 = ActiveSheet.ListObjects("Table2")

'loop over the headers from the source table
For Each h In tbl1.ListColumns
    'is the column name in the "excluded" list?
    If IsError(Application.Match(h.Name, Array("col10", "col11"), 0)) Then

        'ok to copy...
        h.DataBodyRange.Copy tbl2.ListColumns(h.Name).DataBodyRange(1)

    End If
Next h