How do I copy a filtered range into an array? (Excel VBA)

Question

I use this formula to copy unique records from Column A into Column B.

Range("A1", Range("A100").End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True

Instead of copying it into Column B how do you put the filtered results into an array in Excel VBA?

Answer 1

It has been exactly a year since this question was asked but I ran into the same problem today and here is my solution for it:

Function copyFilteredData() As Variant
    Dim selectedData() As Variant
    Dim aCnt As Long
    Dim rCnt As Long

    Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Select
    On Error GoTo MakeArray:
    For aCnt = 1 To Selection.Areas.Count
        For rCnt = 1 To Selection.Areas(aCnt).Rows.Count
            ReDim Preserve SelectedData(UBound(selectedData) + 1)
            selectedData(UBound(selectedData)) = Selection.Areas(aCnt).Rows(rCnt)
        Next
    Next

    copyFilteredData = selectedData
    Exit Function

MakeArray:
    ReDim selectedData(1)
    Resume Next

End Function 

This will leave element 0 of the array empty but UBound(SelectedData) returns the number of rows in the selection

Answer 2

Just in case anyone ever looks at this again... I created this function to work on a 1-D range but it will also write a higher dimension range to a 1-D array; it shouldn't be too hard to modify to write a multiple dimension range to a "same shape" array. You need to have a reference to scrrun.dll to create the dictionary object. Scaling may be a problem since a "for each" loop is used but if you are using EXCEL this is likely nothing you are worried about:

Function RangeToArrUnique(rng As Range)
    Dim d As Object, cl As Range
    Set d = CreateObject("Scripting.Dictionary")
    For Each cl In rng
        d(cl.Value) = 1
    Next cl
    RangeToArrUnique = d.keys
End Function

I've tested this in this way:

Dim dat as worksheet
set dat = sheets("Data")
roomArr = Array("OR01","OR02","OR03")
dat.UsedRange.AutoFilter field:=2, criteria1:=roomArr, operator:=xlFilterValues
fltArr = RangeToArrUnique(dat.UsedRange.SpecialCells(CellTypeVisible))

Hope this helps someone out there!