VBA - array of filtered data to populate listbox

Question

Okay so I am filtering a sheet (\"Data\") by a criteria:

Sub Filter_Offene()
    Sheets(\"Data\").Range(\"A:R\").AutoFilter Field:=18, Criteria1:=\"WAHR\"
En         


        

Answer 1

Try, please the next code, if you want to use a continuous (built) array. It is possible to build it from the discontinuous range address, too:

    Sub Filter_Offene()
      Dim sh As Worksheet, lastRow As Long, rngFilt As Range, arrFin As Variant

      Set sh = Sheets("Data")
      lastRow = sh.Range("R" & Rows.count).End(xlUp).Row
        rngFilt.AutoFilter field:=18, Criteria1:="WAHR"

        Set rngFilt = rngFilt.Offset(1).SpecialCells(xlCellTypeVisible)

        arrFin = ContinuousArray(rngFilt, sh, "R:R")

        With ComboBox1
            .list = arrFin
            .ListIndex = 0
        End With
    End Sub

    Private Function ContinuousArray(rngFilt As Range, sh As Worksheet, colLet As String) As Variant
        Dim arrFilt As Variant, El As Variant, arFin As Variant
        Dim rowsNo As Long, k As Long, i As Long, j As Long, arrInt As Variant

        arrFilt = Split(rngFilt.address, ",")' Obtain an array of areas addresses
        'real number of rows of the visible cells range:
        For Each El In arrFilt
             rowsNo = rowsNo + Range(El).Rows.count
        Next
        'redim the final array at the number of rows
        ReDim arFin(1 To rowsNo, 1 To rngFilt.Columns.count)

        rowsNo = 1
        For Each El In arrFilt            'Iterate between the areas addresses
            rowsNo = Range(El).Rows.count 'number of rows of the area
            arrInt = ActiveSheet.Range(El).value' put the area range in an array
            For i = 1 To UBound(arrInt, 1) 'fill the final array
                k = k + 1
                For j = 1 To rngFilt.Columns.count
                     arFin(k, j) = arrInt(i, j)
                Next j
            Next i
        Next
    ContinuousArray = arFin
End Function

Answer 2

Here is a VBA code to populate UserForm1.ListBox1.List with filtered rows. Thanks to @FaneDuru for improvements in the code edited as per his comments.

In Userform1 code

Private Sub UserForm_Initialize()
PopulateListBoxWithVisibleCells
End Sub

In Module

Sub PopulateListBoxWithVisibleCells()

Dim wb As Workbook, ws As Worksheet
Dim filtRng As Range, rw As Range
Dim i As Long, j As Long, x As Long, y As Long, k As Long, filtRngArr
i = 0: j = 0: x = 0: y = 0

Set wb = ThisWorkbook: Set ws = wb.Sheets("Sheet1")

Set filtRng = ws.UsedRange.Cells.SpecialCells(xlCellTypeVisible)

For Each Area In filtRng.Areas
x = x + Area.Rows.Count
Next
y = filtRng.Columns.Count
ReDim filtRngArr(1 To x, 1 To y)

For k = 1 To filtRng.Areas.Count
For Each rw In filtRng.Areas(k).Rows
    i = i + 1
    arr = rw.Value
    For j = 1 To y
    filtRngArr(i, j) = Split(Join(Application.Index(arr, 1, 0), "|"), "|")(j - 1)

    Next
Next
Next

With UserForm1.ListBox1
.ColumnCount = y
.List = filtRngArr
End With

End Sub

We can also add more fields say row number like Split(rw.Row & "|" & Join(Application.Index(arr, 1, 0), "|"), "|")(j - 1) but for every such intended column increments, we need to increment value of y like y = filtRng.Columns.Count + 1

Answer 3

Here is a fun little fact, Excel creates an hidden named range once you start filtering data. If you have continuous data (headers/rows) this would return your range without looking for it. Though since it seem to resemble UsedRange it may still be better to search your last used column and row and create your own Range variable to filter. For this exercise I'll leave it be. Furthermore, as indicated in the comments above, one can loop over Areas of visible cells. I'd recommend a check beforehand just to be safe that there is filtered data other than headers.

Sub Test()

Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Data")
Dim Area as Range

ws.Cells(1, 1).AutoFilter 18, "WAHR"    
With ws.Range("_FilterDatabase")
    If .SpecialCells(12).Count > .Columns.Count Then
        For Each Area In .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(12).Areas
            Debug.Print Area.Address 'Do something
        Next
    End If
End With

End Sub

The above works if no headers are missing obviously.