VBA Copying data from one table to another and rearranging columns - excel

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

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 2

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

Answer 3

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