Search code examples
arraysexcelvbalistobject

Paste array to certain rows and column within table


I wrote a function to write the contents of a 2-dimensional array to an existing table. Nothing will be removed from the table. The new rows must be added at the bottom. The number of columns depends on the size of the 2nd dimension of the array and I take as an assumption that the table has enough columns.

My issue is: how can I refer to the range in the table without: a) having the sheet with the table as the active sheet and b) without having to reference the worksheet (like is now present in the code; see below)?

See the code below that I tried.

Function PasteArrayToTable(tblDestinationTable As ListObject, arrSourceArray() As Variant)

'Note: works for arrays starting with index = 1 (option base 1)!

Dim lngNewRows As Long
Dim lngHeaderRowPosition As Long
Dim intHeaderColumnPosition As Long
Dim lngFirstRow As Long
Dim lngLastRow As Long
Dim intFirstColumn As Integer
Dim intLastColumn As Integer
Dim lngNrOfRecordsAtStart As Long

'Number of rows to be added
lngNewRows = UBound(arrSourceArray, 1)

'If the array contains rows, then write them to the destination table
If lngNewRows > 1 Then

    'Get header position of destination table
    lngHeaderRowPosition = tblDestinationTable.HeaderRowRange.Row
    intHeaderColumnPosition = tblDestinationTable.HeaderRowRange.Column

    'Get number of records in table before pasting array, in order to remove afterwards an empty row if the table has 0 rows
    lngNrOfRecordsAtStart = tblDestinationTable.ListRows.Count

    'Add rows to table
    tblDestinationTable.Resize tblDestinationTable.Range.Resize(tblDestinationTable.Range.Rows.Count + lngNewRows)

    'Determine positions where to write array to
    lngFirstRow = lngHeaderRowPosition + tblDestinationTable.ListRows.Count + 1 - lngNewRows
    lngLastRow = lngHeaderRowPosition + tblDestinationTable.ListRows.Count
    intFirstColumn = intHeaderColumnPosition
    intLastColumn = intFirstColumn - 1 + UBound(arrSourceArray, 2)

    'Write array to determined positions. Note: there's no check whether the table has the required number of columns, nor
    'whether the number of lines fit on the page
    Dim wks As Worksheet
    Set wks = Worksheets("Blad1")
    With wks
        .Range(.Cells(lngFirstRow, intFirstColumn), .Cells(lngLastRow, intLastColumn)).Value = arrSourceArray
    End With

    'Remove empty row if present
    If lngNrOfRecordsAtStart = 0 Then
        tblDestinationTable.ListRows(1).Delete
    End If

End If

End Function

So how to make a reference to the 'cells' in the table?


Solution

  • Below the code that solves the issue.

    Function PasteArrayToTable(tblDestinationTable As ListObject, arrSourceArray() As Variant)
    
    'Note: works for arrays starting with index = 1 (option base 1)!
    
    Dim lngHeaderRowPosition As Long
    Dim intHeaderColumnPosition As Long
    Dim lngFirstRow As Long
    Dim lngLastRow As Long
    Dim intFirstColumn As Integer
    Dim intLastColumn As Integer
    
    'If the array contains rows, then write them to the destination table
    If UBound(arrSourceArray, 1) > 1 Then
    
        'Get header position of destination table
        lngHeaderRowPosition = tblDestinationTable.HeaderRowRange.Row
        intHeaderColumnPosition = tblDestinationTable.HeaderRowRange.Column
    
        'Determine positions where to write array to
        lngFirstRow = lngHeaderRowPosition + tblDestinationTable.ListRows.Count + 1
        lngLastRow = lngFirstRow + UBound(arrSourceArray, 1) - 1
        intFirstColumn = intHeaderColumnPosition
        intLastColumn = intFirstColumn + UBound(arrSourceArray, 2) - 1
    
        'Write array contents to the bottom of the destination table
        With tblDestinationTable.Parent
            .Range(.Cells(lngFirstRow, intFirstColumn), .Cells(lngLastRow, intLastColumn)).Value = arrSourceArray
        End With
    
    End If
    
    End Function