Home > Mobile >  How can I add different ranges to an array?
How can I add different ranges to an array?

Time:11-15

I have a dataset that contains data in different ranges on a source file that I would like to combine into a single range and copy/paste into a destination file. While union works, I need to run this on a hundred worksheets and it's taking way too long to do the union/copy/paste. I'd like to see if I would get a performance boost from converting into an array.

I have tried doing so by using union to combine the ranges, but i am not able to get the array to initialize to more than one column in doing so. Not sure what I'm doing wrong?

here's an example.

sub CopyData()
dim LastR as long
dim dataArr as variant

with SourceWS
    LastR = .cells(.rows.count,1).end(xlup).row

    dataArr = .union(.range("A8:A" & LastR), _
                     .range("C8:C" & LastR), _
                     .range("H8:H" & LastR))

end with

DestWS.range("A1").resize(ubound(dataArr,1), ubound(dataArr,2)) = dataArr

end sub

CodePudding user response:

I received some help with this on a different forum. The following accomplishes what I'm trying to do:

Sub CombineRanges()

    Dim MyArr() As Variant
    Dim MyRows as Variant

    MyRows = Evaluate("ROW(1:20)")
    MyArr = Application.Index(Columns("A:H"), MyRows, Array(1, 3, 8))
    Range("Z1").Resize(UBound(MyArr, 1), UBound(MyArr, 2)).Value2 = MyArr

End Sub

CodePudding user response:

You posted a solution creating a great datafield array including a lot of unneeded columns in between which you remove via Application.Index() keeping only the column numbers in Array(1,3,8). You might be interested in this overview of some pecularities of Application.Index() I wrote over 3 years ago.

Instead of removing all unneeded columns from a datafield array, you could do the reverse starting from the posted Union range:

  • collect only the existing area data (single columns of identical lengths assumed) in a so called jagged array (aka array of arrays or array container) and
  • unite all to a coherent 2-dim array via Application.Index(data, 0, 0) - note the double zero arguments here!
Option Explicit

Sub CopyData()
'Site: https://stackoverflow.com/questions/69951489/how-can-i-add-different-ranges-to-an-array
'Note: needs identical number of elements in each area of one column!
'[0]build example Union range as in original post
    With Sheet1               ' change as needed
        Dim lastR As Long
        lastR = .Cells(.Rows.Count, 1).End(xlUp).Row
        Dim u As Range
        Set u = Union(.Range("A8:A" & lastR), _
                      .Range("C8:D" & lastR), _
                      .Range("H8:H" & lastR))
    End With

'[1]assign "flat" (transposed) column data to a jagged array (array container)
    Dim data
    With Application
        data = Array(.Transpose(u.Areas(1)), .Transpose(u.Areas(2)), Application.Transpose(u.Areas(3)))
    End With
'[2]unite data as 2-dim array
    data = Application.Transpose(Application.Index(data, 0, 0))
'[3]write to any target (e.g. Sheet2)
    Sheet2.Range("A1").Resize(UBound(data, 1), UBound(data, 2)) = data
End Sub

  • Related