Add Filtered Data to a ListBox in Userform

[RockandGrohl]

Hi guys

I have a userform that has a search box. If the user searches "Apple" it filters a table on "IntF" sheet column C to have anything with "Apple" in it

I would then like a maximum of 20 of these to be added to my IntListBox Listbox on my userform.


I've set my Listbox to have 5 columns in Userform Initialize, and would like the filtered results for each row from cells D to H to be added to the ListBox.

Here's me code so far

Private Sub IntSearchButton_Click()

Application.ScreenUpdating = False

    Dim AssetVal As String
    Dim intF As Worksheet
    Dim Lastrow As Long
    Dim filterRange As Range
    Dim visibleCells As Range

    Set intF = Worksheets("InterventionFilter")
    Set filterRange = intF.Range("D:H")

    AssetVal = Me.IntSearchBox.Value

    If AssetVal = "" Then
        Exit Sub
    End If

    On Error Resume Next
    intF.ShowAllData
    On Error GoTo 0

    intF.Activate
    Lastrow = intF.Cells(Rows.Count, "A").End(xlUp).Row
    intF.Range("A1:W" & Lastrow).AutoFilter Field:=3, Criteria1:="*" & AssetVal & "*"

    ' Count visible cells in the filtered range
    On Error Resume Next
    Set visibleCells = filterRange.SpecialCells(xlCellTypeVisible).Offset(1, 0).Resize(filterRange.Rows.Count - 1)
    On Error GoTo 0

    If Not visibleCells Is Nothing Then
        Me.IntListBox.List = visibleCells.Value
    End If

    ' Check if there are visible cells in the filtered range
    If Not visibleCells Is Nothing Then
        ' Your code to populate ListBox here
        Me.IntListBox.List = visibleCells.Value
    Else
        MsgBox "No results found"
    End If

    Application.ScreenUpdating = True
End sub

In the future, I want the user to click only one of the results in the listbox and have that selection applied to ComboBoxes on the same userform. That shouldn't be too difficult.


Thank you!

 

[RockandGrohl]

Bump. I forgot to mention, the error I'm having is that line:

    Set visibleCells = filterRange.SpecialCells(xlCellTypeVisible).Offset(1, 0).Resize(filterRange.Rows.Count - 1)

Results in the "visibleCells" returning "Nothing", even when there are filtered results.

 

[RockandGrohl]

I'm trying to now do this the simpler way by copying the filtered results to a different sheet and adding them to the columns in the listbox there, but no luck.

In userform initialization I have this:

Me.IntListBox.ColumnCount = 5
Me.IntListBox.ColumnWidths = "50;50;50;50;50"

Then, when the user inputs a search term which filters the results, it's supposed to add them like this:

Private Sub IntSearchButton_Click()

Application.ScreenUpdating = False

Dim AssetVal As String
Dim intF As Worksheet, val As Worksheet
Dim Lastrow As Long
Dim i As Integer
Dim filterRange As Range, visibleCells As Range, cell As Range

Set intF = Worksheets("InterventionFilter")
Set val = Worksheets("Validation")
Set filterRange = intF.Range("D:H")

AssetVal = Me.IntSearchBox.Value

If AssetVal = "" Then
    Exit Sub
End If

On Error Resume Next
intF.ShowAllData
On Error GoTo 0

intF.Activate
Lastrow = intF.Cells(Rows.Count, "A").End(xlUp).Row
intF.Range("A1:W" & Lastrow).AutoFilter Field:=3, Criteria1:="*" & AssetVal & "*"


RowCount = intF.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
If RowCount < 1 Then
    MsgBox "No results found"
    Exit Sub
End If

val.Range("BE2:BI5000").ClearContents
intF.Range("D2:H" & Lastrow).Copy
val.Range("BE2").PasteSpecial xlPasteValues

Me.IntListBox.Clear

For i = 2 To RowCount + 1
        ' Loop through each cell in the row
        For Each cell In intF.Range("BE" & i & ":BI" & i)
            ' Add the value to the listbox
            Me.IntListBox.AddItem cell.Value
        Next cell
    Next i

Application.ScreenUpdating = True

End Sub

What happens is the code executes without issue, but there's no data in the listbox.

 

[NoSparks]

try copying the filtered data to a spare sheet and loading the listbox from there
something along the lines of this

Private Sub IntSearchButton_Click()

Application.ScreenUpdating = False

    Dim AssetVal As String
    Dim intF As Worksheet
    Dim Lastrow As Long
    Dim filterRange As Range
    Dim x As Long
    
    AssetVal = Me.IntSearchBox.Value
    If AssetVal = "" Then
        Exit Sub
    End If
    
    Set intF = Worksheets("InterventionFilter")
    On Error Resume Next
    intF.ShowAllData
    On Error GoTo 0
    
    intF.Activate
    Lastrow = intF.Cells(Rows.Count, "A").End(xlUp).Row
    
    Set filterRange = intF.Range("D1:H" & Lastrow)
    
    intF.Range("A1:W" & Lastrow).AutoFilter Field:=3, Criteria1:="*" & AssetVal & "*"

    ' Copy the filtered data to a spare sheet
    filterRange.AdvancedFilter Action:=xlFilterCopy, Unique:=True, CopyToRange:=Sheet3.Range("A1")
    ' Count visible cells in the filtered range
    With Sheet3
        Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
        x = Application.WorksheetFunction.Min(Lastrow - 1, 20)
        Me.IntListBox.List = Sheet3.Range("A2").Resize(x, 5).Value
        ' clear spare sheet
        .Cells.Delete
    End With

Application.ScreenUpdating = True

End Sub

 

[RockandGrohl]

try copying the filtered data to a spare sheet and loading the listbox from there
something along the lines of this

Private Sub IntSearchButton_Click()

Application.ScreenUpdating = False

    Dim AssetVal As String
    Dim intF As Worksheet
    Dim Lastrow As Long
    Dim filterRange As Range
    Dim x As Long
   
    AssetVal = Me.IntSearchBox.Value
    If AssetVal = "" Then
        Exit Sub
    End If
   
    Set intF = Worksheets("InterventionFilter")
    On Error Resume Next
    intF.ShowAllData
    On Error GoTo 0
   
    intF.Activate
    Lastrow = intF.Cells(Rows.Count, "A").End(xlUp).Row
   
    Set filterRange = intF.Range("D1:H" & Lastrow)
   
    intF.Range("A1:W" & Lastrow).AutoFilter Field:=3, Criteria1:="*" & AssetVal & "*"

    ' Copy the filtered data to a spare sheet
    filterRange.AdvancedFilter Action:=xlFilterCopy, Unique:=True, CopyToRange:=Sheet3.Range("A1")
    ' Count visible cells in the filtered range
    With Sheet3
        Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
        x = Application.WorksheetFunction.Min(Lastrow - 1, 20)
        Me.IntListBox.List = Sheet3.Range("A2").Resize(x, 5).Value
        ' clear spare sheet
        .Cells.Delete
    End With

Application.ScreenUpdating = True

End Sub

Hi,

I ended up with something materially the same as this - it copies to a new sheet and loads there using the Rowsource property. To clear the list, I simply clear the row source.

Thanks for your help anyway, I'll mark it as the correct answer. You posted it a few moments after I found a solution.

 

[NoSparks]

Glad you've got it figured.

Section 0.2 "Populating methods"
at this site may (or may not) be of interest to you.