Write only certain elements / columns of a 2 dimensional array back to worksheet

Question

I have a dynamic 2 dimensional array that has way more data than i need and i only want to write certain elements (columns) of the array back to the worksheet. Is this possible? For example:

Sub writeArray()
Dim wsSource   As Worksheet
Dim wsDest     As Worksheet
Dim arSource() As Variant
Dim a          As Long
Dim b          As Long

Set wsDest = wbPT.Worksheets("Import")
Set wsSource = wbSource.Worksheets("Export")

wsDest.Activate

ReDim Preserve arSource(3 To wsSource.Range("B" & Rows.Count).End(xlUp).row, 2 To 40) '

For a = LBound(arSource, 1) To UBound(arSource, 1)
    For b = LBound(arSource, 2) To UBound(arSource, 2)
        arSource(a, b) = wsSource.Cells(a, b)
    Next b
Next a 
End Sub

This array has 3 to 271 elements in the first dimension and 2 to 40 in the second dimension.

Of the 39 elements (columns) I only want these columns: 4, 5, 6, 7, 8, 23, 35, and 36.

On the destination worksheet that correlates to columns: 2, 3, 4, 5, 6, 7, 13, and 14. I would need column 4 from the source array to now move to column 2 on the destination worksheet and column 5 from the source to be in column 3 in the destination sheet and so on with the 8 columns. I do not need any of the other data. - Should I be trying to do this another way?

If it works and is fast enough, then I wouldn't change things. If it is too slow, you can speed things up by creating an output array in VBA, and then writing the entire array in one step per contiguous group of columns to the worksheet (as compared with writing each cell one at a time). — Ron Rosenfeld, May 24 '20 at 12:52

score 1 · Accepted Answer · answered May 24 '20 at 16:26

I would create two arrays with the column numbers in the source and destination worksheets and then you can reduce your loops to just 1 which finds the number of cells in the column of the source worksheet and then copies that range to the destination worksheet.

Sub TestWriteArray()

    Dim inputColumns As Variant
    inputColumns = Array(4, 5, 6, 7, 8, 23, 35, 36)

    Dim outputColumns As Variant
    outputColumns = Array(2, 3, 4, 5, 6, 7, 13, 14)

    writeArray inputColumns, outputColumns
End Sub



Sub writeArray(ByVal ipSourceColumns As Variant, ByVal ipDestColumns As Variant)

    If UBound(ipSourceColumns) <> UBound(ipDestColumns) Then

        Err.Raise _
            17, _
            "Columns Mismatch", _
            "The number of columns in the source and desination arrays do not match"

    End If

    Dim wsSource As Worksheet
    Set wsSource = ActiveWorkbook.Worksheets("Sheet1")

    Dim wsDest As Worksheet
    Set wsDest = ActiveWorkbook.Worksheets("Sheet2")


    Dim myIndex As Long
    For myIndex = LBound(ipSourceColumns) To UBound(ipSourceColumns)

        Dim myLastRow As Long
        myLastRow = wsSource.Cells(Rows.Count, ipSourceColumns(myIndex)).End(xlUp).Row
        wsSource.Range(wsSource.Cells(3, ipSourceColumns(myIndex)), wsSource.Cells(myLastRow, ipSourceColumns(myIndex))).Copy
        wsDest.Cells(3, ipDestColumns(myIndex)).PasteSpecial xlPasteAll

    Next

End Sub

This did the trick! Thank you so much freeflow. I that was also way quicker than how i was trying to do it. I cannot thank you enough for your help. — Adam Rhodes, May 26 '20 at 07:19

score 1 · Answer 2 · answered May 24 '20 at 19:13

Copying array in two sequences only

Just for fun and in order to demonstrate how you could slice the entire data array into only two temporary sequences using the advanced possibilities of the Application.Index()function instead of copying ranges. - This alternative approach doesn't pretend to be a faster or better solution than the one above, but might be worth studying for a better understanding of array methods.

Sequence (1) extracts the first 6 columns and writes them all to target column 2 and neighbour columns (i.e. B:G),
Sequence (2) writes the remaining two columns to target column 13 + neighbour (i.e. M:N).

Example call

   ExtractGivenColumns wsSource , wsDest   ' using the predeclared worksheet objects

or e.g.

   ExtractGivenColumns Sheet1, Sheet2      ' using the project's sheet Code(Name)s

Sub ExtractGivenColumns(src As Worksheet, tgt As Worksheet)
'Purpose: extract given array columns to target cell ranges
'Author:  https://stackoverflow.com/users/6460297/t-m

'[1] assign data to (1-based) 2-dim variant datafield array
With src
    Dim lastRow As Long: lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    Dim data: data = .Range("A3:A" & lastRow).Resize(columnsize:=40)
End With

'[2] define columns and target cells in 2 sequences
'    targeting first to B3 (start cell in column 2) and then to M3 (start cell in column 13)
Dim srcRows, srcCols(1 To 2), tgtCell(1 To 2)
srcRows = Evaluate("ROW(1:" & (lastRow - 1) & ")")          ' defines the entire rows set
srcCols(1) = Array(4, 5, 6, 7, 8, 23): tgtCell(1) = "B3"    ' Sequence 1 extracts columns 4,5,6,7,8,23
srcCols(2) = Array(35, 36): tgtCell(2) = "M3"               ' Sequence 2 extracts columns 35 and 36

'[3] extract columns and write them to two target cells B3 and M3 (2 sequences)
Dim i As Long, tmp
For i = 1 To 2                                              ' loop thru both target sequences
    tmp = Application.Index(data, srcRows, srcCols(i))
    tgt.Range(tgtCell(i)).Resize(UBound(data), UBound(srcCols(i)) + 1) = tmp
Next

End Sub

Thank you for your approach. I have heard of slicing but I am not confident enough in my ability. I am going mess with it and see if I can learn more. — Adam Rhodes, May 26 '20 at 09:39

Write only certain elements / columns of a 2 dimensional array back to worksheet

2 Answers2