How to show filtered rows in userform listbox

Question

I have one Excel sheet and a listbox in a userform.

When I filter my sheet and update listbox by clicking on a button on my userform I see all rows in the listbox. I mean listbox1 show all cells (filter + no filter).

My code for updating the listbox:

Private Sub CommandButton1_Click()
    CommandButton10.Visible = True
    insertlist1.Visible = True
    ListBox1.Visible = True
    ListBox1.RowSource = "'NEWPRJ'!D7:D46"
End Sub

Solution 1

The code below reads only Visible cells after Filter was applied to Range("D7:D46") in "NEWPRJ" sheet, it saves them to MyArr array, and then shows them in ListBox1 listbox in your User_Form.

Using .SpecialCells(xlCellTypeVisible) allows reading only visible cells.

Option Explicit

Private Sub CommandButton1_Click()

Dim cell As Range
Dim MyArr  As Variant, i As Long

' intialize array to high number of elements at start
ReDim MyArr(0 To 10000)

' work on sheets "NEWPRJ" according to PO
With Sheets("NEWPRJ")
    ' scan each cell in Range "D7:D46" only on visible cells (cells that are visible after the filter was applied)
    For Each cell In .Range("D7:D46").SpecialCells(xlCellTypeVisible)
        MyArr(i) = cell.Value ' read all visible cells to array
        i = i + 1
    Next cell
    ' reduce array size to populated elements only
    ReDim Preserve MyArr(0 To i - 1)

    ' populate listbox with array
    ListBox1.List = MyArr
End With

End Sub

Solution 2

When using arrays, the listbox header goes away...
So you could try to solve the problem using two ideas:
1. Sort the table, to make the filtered values come to top (under the header of the table);
2. Filter the table;

Private Sub fillListBox()
'lstGrade as the listbox component
Dim oTab As ListObject
Dim oRng As Range
    Set oTab = Sheets("Sheet1").ListObjects("MyTable")

    'remove any filter and then sort the data using the "SomeValue" to stick it on top of the table
    With oTab
        .Range.AutoFilter
        .Sort.SortFields.Clear
        .Sort.SortFields.Add _
            Key:=Range("MyTable[Column3]"), _
            SortOn:=xlSortOnValues, _
            Order:=xlAscending, _
            CustomOrder:="SomeValue", _
            DataOption:=xlSortNormal
        With .Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With

    'note that "SomeValue" is the same as in the sorted area above
    oTab.Range.AutoFilter 2, "SomeValue"

    '"save" the data into the new range object
    Set oRng = oTab.DataBodyRange.SpecialCells(xlCellTypeVisible)
    lstGrade.RowSource = oRng.Address
End Sub