excelvbaexcel-tableslistobject

Create a table in Sheet2 by iterating through rows in Sheet1


I want to use VBA to create a table for import to our ERP system.

Desired state: I press a button on Sheet2, the VBA code iterates through each row of a power query table on Sheet1, then paste each row into Sheet2 and have a row number generated for each iteration. The resulting VBA table should have all the values / rows from the table in Sheet1, as well as row number for each loop iteration and columns with static values for data import formatting purposes (ex: the "min_qty" and "next row" in target table below).

example:

source power query table in Sheet1:

Item Attribute
001 Red
002 Blue
003 Purple
... ...
099 Cyan

Target table in Sheet2 (before code is run)

Item Attribute row_nbr min_qty next row

Target table in Sheet2 (after code is run)

Item Attribute row_nbr min_qty next row
001 Red 1 1.01 yes
002 Blue 2 1.01 yes
003 Purple 3 1.01 yes
... ... ... ... ...
099 Cyan 99 1.01 yes

The length of the item dimension table in Shee1 is variable, so I would need to have the iterator stop at the end of the table object or when the value in that table is a blank string (i.e. ""), whatever is best practice.

One last thing, to avoid replicating data imported to the ERP system, I would want to have the VBA code clear out all of the cell contents of the VBA table's destination range if any exists. I am thinking something like what the CurrentRegion function does to select all tabular data. For example, if last import was 700 rows, but this one is 600 rows, there will be 100 rows from the last import if VBA doesn't clear out old contents.

I really appreciate any guidance, as I have no experience with VBA coding myself.


Solution

  • Update Excel Table

    Sub UpdateTable()
        
        ' Workbook
        Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
        
        ' Source
        Dim sws As Worksheet: Set sws = wb.Sheets("Sheet1")
        Dim slo As ListObject: Set slo = sws.ListObjects(1) ' or e.g. "Table1"
        If slo.ListRows.Count = 0 Then
            MsgBox "No data in source table """ & slo.Name & """!", vbExclamation
            Exit Sub
        End If
        Dim srCount As Long: srCount = slo.DataBodyRange.Rows.Count
        
        ' Destination
        Dim dws As Worksheet: Set dws = wb.Sheets("Sheet2")
        Dim dlo As ListObject: Set dlo = dws.ListObjects(1) ' or e.g. "Table2"
        
        ' Copy values.
        With dlo
            If .ShowAutoFilter Then
                If .AutoFilter.FilterMode Then .AutoFilter.ShowAllData
            End If
            If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
            With .HeaderRowRange.Offset(1).Resize(srCount)
                .Resize(, 2).Value = slo.DataBodyRange.Value ' source table data
                .Columns(3) = dws.Evaluate("ROW(1:" & srCount & ")") ' row numbers
                .Columns(4) = 1.01 ' constant
                .Columns(5) = "yes" ' constant
            End With
        End With
        
        ' Inform.
        MsgBox "Table """ & dlo.Name & """ updated.", vbInformation
        
    End Sub