Copy Multiple Non-Adjacent Columns To Array

Issue

I’m trying to copy multiple non-adjacent (non-contiguous) excel columns to an array but it’s not working. Below is what I’ve tried…

    Public Function Test()    
        Dim sh As Worksheet: Set sh = Application.Sheets("MyWorksheet")
        Dim lr As Long: lr = sh.Cells(sh.Rows.Count, 1).End(xlUp).row
        Dim r1 As Range: Set r1 = sh.Range("A1:A" & lr)
        Dim r2 As Range: Set r2 = sh.Range("C1:C" & lr)
        Dim rAll As Range: Set rAll = Union(r1, r2)
        'Dim arr() As Variant: arr = Application.Transpose(rAll) <-- Throws Type mismatch error
        'Dim arr As Variant: arr = Application.Transpose(rAll) <-- arr Value = Error 2015
        Dim arr() As Variant: arr = rAll.Value2 ' <-- Only the first column (col A) is loaded.
    End Function

Any help is greatly appreciated!

Solution

Thank you PEH,
Great explanation which led me to the following solution:

    Function Test()
       Dim sh as Worksheet : set sh = Sheets("MySheet")
       Dim lr as Long : lr = sh.Cells(sh.Rows.Count, 1).End(xlUp).row
       Dim arr () as Variant
       Dim idx as Long

       ' Delete unwanted columns to ensure contiguous columns...
       sh.Columns("B:B").Delete

       ' Load Array
       arr = Sheet("MySheet").Range("A1:B" & lr).value2

       ' This allows speedy index finds... Note, index(arr, startrow, keycol) 
       ' Will need to use "On Error" to handle key not being found
       idx = WorksheetFunction.match("MyKey", WorksheetFunction.Index(arr, 0, 2), 0)

       ' And then fast processing through the array
       For idx = idx to lr
          if (arr(idx, 2) <> "MyKey") then exit for
          ' do some processing...
       Next idx
   End Function

Thank you again!

Answered By – Mike

Answer Checked By – Clifford M. (AngularFixing Volunteer)

Leave a Reply

Your email address will not be published.