Filter in listBox

[Ferreira1456]

I have a form with a ListBox. Which is filled in when I open the form.

I'm using the following code:

Private Sub UserForm_Initialize()

Dim last_Row As Long

last_Row = Application.WorksheetFunction.CountA(sh.Range("A:A"))

With Me.ListBox1

.ColumnHeads = True

.ColumnCount = 61

.ColumnWidths = "20,40,60,0,50,120,0,0,0,0,0,120,120,0,0,0,0,0,0,0,0,0,0,40,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0"

If last_Row = 1 Then

.RowSource = "Customers!A2:BI2"

Else

.RowSource = "Customers!A2:BI" & last_Row

End If

End With

End Sub

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

I have a button to do the Filter with this code::

Private Sub cmdSearch_Click()

Dim sh As Worksheet

Set sh = Sheets("Customers")

sh.Select

sh.Range("$A$1:$BI$270000").AutoFilter Field:=6, Criteria1:="=*" & Me.txtSearchByName.Value & "*"

sh.Range("$A$1:$BI$270000").AutoFilter Field:=24, Criteria1:="=*" & Me.txtSearchByStatus.Value & "*"

End Sub

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

I have the third button to clean the filter.

Private Sub cmd CleanFilter_Click()

ActiveSheet.ShowAllData

End Sub

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

From here, I need your help. When the filter is ready. I need the same listBox to be filled with the filter.
Also, I need that when I double-click the ListBox line, all TextBox and ComboBox are filled.
The column where the filter is made is column “F”.

Thank you very much.

 

[Siddharth Rout]

I would do this in a slightly different way. You may like what I am going to suggest you. If you don't, then feel free to ingore my post.

First things first. Create a temporary sheet and call it "Temp".

Next hide this sheet. We will use this sheet to create a Table and then pass that table as the rowsource to the listbox. This way, your listbox will actually have headers. The headers will not scroll and will remain fixed when you use the scrollbar.

For demonstration purpose, my Customers sheet looks like this

My Control Names:

Userform : UserForm1
Filter Button: CmdFilter
Clear Filter: CmdClear
Search By Name: SearchByName
Search By Status: SearchByStatus
ListBox: LBData

Code:

Paste this code in the Userform Code area. I have commented the code. If you still have any questions, feel free to ask.

Option Explicit

Dim ws As Worksheet, wsTemp As Worksheet
Dim lRow As Long

'~~> Userform Initialize event
Private Sub UserForm_Initialize()
    '~~> Set your worksheets here
    Set ws = ThisWorkbook.Sheets("Customers")
    Set wsTemp = ThisWorkbook.Sheets("Temp")
   
    '~~> Populate the listbox
    PopulateListBox
   
    '~~> Listobx settings and assigning of data
    With LBData
        .ColumnHeads = True
        .ColumnCount = 61
        .ColumnWidths = "20;40;60;0;50;120;0;0;0;0;0;120;120;0;0;0;0;0;0;0;0;0;0;40;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0"
        .RowSource = "MyTable"
    End With
End Sub

'~~> This is the filter button
Private Sub CmdFilter_Click()
    lRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

    '~~> Check if there is any data to filter
    If lRow = 1 Then
        MsgBox "There is no data in the worksheet"
        Exit Sub
    End If
   
    Dim rngFilter As Range
   
    '~~> Clear listbox
    LBData.RowSource = ""
    '~~> Claer temp sheet for input
    wsTemp.Cells.Clear
   
    With ws
        '~~> Copy headers from Customers to temp sheet
        .Rows(1).Copy wsTemp.Rows(1)
       
        '~~> Remove an filters
        .AutoFilterMode = False
       
        '~~> Filter your data
        With .Range("A1:BI" & lRow)
            .AutoFilter Field:=6, Criteria1:="=*" & SearchByName.Text & "*"
            .AutoFilter Field:=24, Criteria1:="=*" & SearchByStatus.Text & "*"
           
            '~~> Identify your filtered data
            On Error Resume Next
            Set rngFilter = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
            On Error GoTo 0
        End With
       
        .AutoFilterMode = False
    End With
   
    '~~> Copy the filtered data to temp sheet
    If Not rngFilter Is Nothing Then
        rngFilter.Copy wsTemp.Range("A2")
       
        Application.CutCopyMode = False
       
        '~~> Create a table
        With wsTemp
            lRow = .Range("A" & .Rows.Count).End(xlUp).Row
            .ListObjects.Add(xlSrcRange, .Range("A1:BI" & lRow), , xlYes).Name = "MyTable"
        End With
       
        '~~> Set the rowsource of the listbox
        LBData.RowSource = "MyTable"
    End If
End Sub

'~~> Clear the filter
Private Sub CmdRemoveFilter_Click()
    PopulateListBox
    LBData.RowSource = "MyTable"
    SearchByName.Text = ""
    SearchByStatus.Text = ""
End Sub

'~~> Double click event
Private Sub LBData_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    If LBData.ListIndex = -1 Then Exit Sub
   
    '~~> I am showing 2 values in message box. Store relevant values in relevant textboxes, comboboxes
    With LBData
        MsgBox .List(.ListIndex, 5)     '<~~ Col F value
        MsgBox .List(.ListIndex, 23)    '<~~ Col X value
    End With
End Sub

'~~> Populate the listbox with unfiltered data
Private Sub PopulateListBox()
    '~~> Clear temp sheet
    wsTemp.Cells.Clear
   
    Dim rng As Range
   
    With ws
        .AutoFilterMode = False
       
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
       
        If lRow = 1 Then
            Set rng = .Range("A2:BI2")
        Else
            Set rng = .Range("A2:BI" & lRow)
        End If
       
        '~~> Copy data to temp sheet
        .Rows(1).Copy wsTemp.Rows(1)
        rng.Copy wsTemp.Range("A2")
       
        Application.CutCopyMode = False
       
        '~~> Create table
        wsTemp.ListObjects.Add(xlSrcRange, wsTemp.Range("A1:BI" & lRow), , xlYes).Name = "MyTable"
    End With
End Sub

In Action:

Disclaimer:

I have not extensively tested the above code. Please make a backup of your file before you test this code. If you get any errors, feel free to post a screenshot of the error and also mention the line where the error is happening.

 

[Ferreira1456]

Dude, your help was just the best. Thank you very much.

 

[Siddharth Rout]

Dude, your help was just the best. Thank you very much.

Thanks for the feedback.

 

[Ferreira1456]

Hi Siddharth Rout,
Sorry to bother you, but I ran into a problem here, when I add clients to the spreadsheet, they don't show up in the filter.
Maybe you can help me with this.
Thank you very much.

 

[Ferreira1456]

Private Sub CmdFilter_Click()

lRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

'~~> Check if there is any data to filter

If lRow = 1 Then

MsgBox "There is no data in the worksheet"

Exit Sub

End If


Dim rngFilter As Range


'~~> Clear listbox

LBData.RowSource = ""

'~~> Claer temp sheet for input

wsTemp.Cells.Clear


With ws

'~~> Copy headers from Customers to temp sheet

.Rows(1).Copy wsTemp.Rows(1)


'~~> Remove an filters

.AutoFilterMode = False


'~~> Filter your data

With .Range("A1:BI" & lRow)

.AutoFilter Field:=6, Criteria1:="=*" & SearchByName.Text & "*"

.AutoFilter Field:=24, Criteria1:="=*" & SearchByStatus.Text & "*"


'~~> Identify your filtered data

On Error Resume Next

Set rngFilter = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow

On Error GoTo 0

End With


.AutoFilterMode = False

End With


'~~> Copy the filtered data to temp sheet

If Not rngFilter Is Nothing Then

rngFilter.Copy wsTemp.Range("A2")


Application.CutCopyMode = False


'~~> Create a table

With wsTemp

lRow = .Range("A" & .Rows.Count).End(xlUp).Row

.ListObjects.Add(xlSrcRange, .Range("A1:BI" & lRow), , xlYes).Name = "MyTable"

End With


'~~> Set the rowsource of the listbox

LBData.RowSource = "MyTable"

End If

End Sub