Filtering a listbox from multiple entries in comboboxes

[JonnyAngelo]

Hello and a happy new year to everyone on this forum!

I am trying to filter a listbox full of data from one of the worksheets.
I have 8 combo-boxes that have options within them which i want to utilise
to filter the information already in the list box. I already have the listbox
working when i start up the userform.
There are 20 columns within the listbox data and 8 of them are
associated with the 8 combo-boxes.

Here is an image of the userform that i have created for this (apologies for the scribbles, had to hide some of the data shown):

I feel as if this is an easy code to fix up but i'm still learning VB and am unsure as how to do this,
Feel free to share your suggestions.

Thank you, Jonny.

 

[JonnyAngelo]

I Tried fiddling with your file and now i've realised what you've done.
Is there a possible way in which i can keep some of the fields empty and still have
values come up, for example, only select "private" and have random values appear for the
other 7 columns. Not sure if i'm being clear.

Thanks, Jonny

 

[MickG]

Should have said , you need to fill in all the Comboxes.
Does it work with all 8 comboboxes filled ???

I'll Have a Think about Partial filling !!

 

[JonnyAngelo]

Here is the file:
https://app.box.com/s/ooakr8g7wd5t8z1sj6npplvpminebvyy

You'll find the module under frmAdvFilter.

I'm unable to check if it works with all 8 combo-boxes filled in my userform as some columns are still empty.

 

[MickG]

I'll look at your File, meanwhile have a look a example of partial filling of Comboboxes.
https://app.box.com/s/2t7rtq8rjy9m46tlmbwz22v7fayh0j5p

 

[wideboydixon]

I've been playing around with this for some time. Without wishing to step on any toes, I decided that filtering the range was the way to go. Here's a complete dump of what I had in the frmAdvFilter code:

Option Explicit
Private landlordData As Range
Private tempSheet As Worksheet
Sub resetForm()


With Me
    .cbDSS.Value = ""
    .cbContract.Value = ""
    .cbType.Value = ""
    .cbIncl.Value = ""
    .cbFloor.Value = ""
    .cbMais.Value = ""
    .cbKitch.Value = ""
    .cbGar.Value = ""
End With


landlordData.AutoFilter
PopulateListBox


End Sub
Private Sub cmdClose_Click()


'close the userform
landlordData.AutoFilter
tempSheet.Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Unload Me


End Sub
Private Sub cmdClear_Click()


Call resetForm


End Sub
Private Sub CmdFilter_Click()


Dim cbBox As Variant
Dim checkFilter As Long


cbBox = Array(cbDSS, cbContract, cbType, cbIncl, cbFloor, cbMais, cbKitch, cbGar)


landlordData.AutoFilter
For checkFilter = 0 To UBound(cbBox)
    If cbBox(checkFilter) <> "" Then
        landlordData.AutoFilter Field:=11 + checkFilter, Criteria1:=cbBox(checkFilter)
    End If
Next checkFilter


PopulateListBox


End Sub
Private Sub UserForm_Initialize()


Dim lastRow As Long
Dim lastCol As Long


With Sheets("LandLord")
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    lastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
    Set landlordData = .Range(.Range("A2"), .Cells(lastRow, lastCol))
End With


Set tempSheet = Sheets.Add


Application.DisplayAlerts = False
Application.ScreenUpdating = False
     
With cbDSS
    .AddItem "DSS"
    .AddItem "Private"
    .AddItem ""
End With
With cbContract
    .AddItem "6 Months"
    .AddItem "1 Year"
    .AddItem "2 Years"
    .AddItem ""
End With
With cbType
    .AddItem "Studio"
    .AddItem "1 Bedroom"
    .AddItem "2 Bedroom"
    .AddItem "3 Bedroom"
    .AddItem "4 Bedroom"
    .AddItem "5 Bedroom"
    .AddItem ""
End With
With cbIncl
    .AddItem "Council Tax"
    .AddItem "Electricity"
    .AddItem "Gas"
    .AddItem "Water"
    .AddItem "Tv"
    .AddItem "No Bills"
    .AddItem ""
End With
With cbFloor
    .AddItem "Ground Floor"
    .AddItem "1st Floor"
    .AddItem "2nd Floor"
    .AddItem "3rd Floor"
    .AddItem "Loft"
    .AddItem "N/A"
    .AddItem ""
End With
With cbMais
    .AddItem "Yes"
    .AddItem "No"
    .AddItem ""
End With
With cbKitch
    .AddItem "Open Plan"
    .AddItem "Separate"
    .AddItem ""
End With
With cbGar
    .AddItem "Yes"
    .AddItem "No"
    .AddItem ""
End With


resetForm


End Sub
Private Sub PopulateListBox()


Dim thisRow As Long
Dim filteredRange As Range


On Error Resume Next


With Me.lstData
    'Determine number of columns
    .ColumnCount = landlordData.Columns.Count
    'Set column widths
    .ColumnWidths = "50;50;60;60;100;60;75;40;40;40;50;40;50;50;65;20;75;20;50;40;"
    'Insert the range of data supplied
    .Clear
    For thisRow = 2 To landlordData.Rows.Count
        If landlordData.Rows(thisRow).Hidden = False Then
            If filteredRange Is Nothing Then
                Set filteredRange = landlordData.Rows(thisRow)
            Else
                Set filteredRange = Application.Union(filteredRange, landlordData.Rows(thisRow))
            End If
        End If
    Next thisRow
    tempSheet.Cells.Clear
    filteredRange.Copy Destination:=tempSheet.Range("A1")
    .List = tempSheet.Range("A1").CurrentRegion.Resize(, 20).Value
End With


End Sub

WBD

 

[JonnyAngelo]

Hey WBD,

Apologies for the late reply, i was out the office for a while.

I tried replacing my code with yours and it works great when the Landlord page is on focus.
However, i have a button on the Home Page in which i open the filter with.
When running it through the button, a new blank sheet get created and when i close the
userform, the listbox data gets pasted onto it. Is there any way i can fix the code so that none of this happens?

Many Thanks, Jonny.

 

[JonnyAngelo]

UPDATE:

After restarting Excel the problem seemed to have disappeared, but occasionally,
some screen flickering still occurs, for example, i see a new temp spreadsheet being created
behind the Filter userform when i open it up. It also flickers when i click on the cmdCancel button.
Any fix?

 

[MickG]

See Return File Modified:-
https://app.box.com/s/b6vnldqzv515u9rc2c23rgx8iurr1fk8

 

[JonnyAngelo]

Excellent bits of coding you guys, both of them also work fantastically well!
However, a new problem has come up and once i click on the button "Close Filter",
the screen does a small flicker and then goes back to that Home Page.
It happens on both codes. Not sure if its been an error that i've created on the
cmdCancel button myself.

Apologies for being picky, i just need it to appear very professional for my colleagues.

 

[MickG]

Remove line in Red !!!

Private Sub UserForm_Initialize()
Dim RngSource As Range
Application.ScreenUpdating = False
Worksheets("Landlord").Activate
    Dim lbtarget As MSForms.ListBox
    Dim sht As Worksheet
    Dim LastRow As Long
    Dim LastColumn As Long
    Dim StartCell As Range
Set sht = Worksheets("Landlord")
Set StartCell = Range("A3:T3")
'Find Last Row and Column
  LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
  LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column
'Select Range
  sht.Range(StartCell, sht.Cells(LastRow, LastColumn)).Select
  
'Set reference to the range of data to be filled
    'Set rngSource = Worksheets("Landlord").Range("A3:T20")
    Set RngSource = Worksheets("Landlord").Range(StartCell, sht.Cells(LastRow, LastColumn))
     'Fill the listbox
    Ray = RngSource.Value
    Set lbtarget = Me.lstData
    With lbtarget
         'Determine number of columns
        .ColumnCount = -1
         'Set column widths
        .ColumnWidths = "50;50;60;60;100;60;75;40;40;40;50;40;50;50;65;20;75;20;50;40;"
         'Insert the range of data supplied
        .List = RngSource.Cells.Value
 
[B][COLOR=#FF0000]Worksheets("HomePage").Activate[/COLOR][/B]
     End With
     
With cbDSS
.AddItem "DSS"
.AddItem "Private"
.AddItem ""
End With
With cbContract
.AddItem "6 Months"
.AddItem "1 Year"
.AddItem "2 Years"
.AddItem ""
End With
With cbType
.AddItem "Studio"
.AddItem "1 Bedroom"
.AddItem "2 Bedroom"
.AddItem "3 Bedroom"
.AddItem "4 Bedroom"
.AddItem "5 Bedroom"
.AddItem ""
End With
With cbIncl
.AddItem "Council Tax"
.AddItem "Electricity"
.AddItem "Gas"
.AddItem "Water"
.AddItem "Tv"
.AddItem "No Bills"
.AddItem ""
End With
With cbFloor
.AddItem "Ground Floor"
.AddItem "1st Floor"
.AddItem "2nd Floor"
.AddItem "3rd Floor"
.AddItem "Loft"
.AddItem "N/A"
.AddItem ""
End With
With cbMais
.AddItem "Yes"
.AddItem "No"
.AddItem ""
End With
With cbKitch
.AddItem "Open Plan"
.AddItem "Separate"
.AddItem ""
End With
With cbGar
.AddItem "Yes"
.AddItem "No"
.AddItem ""
End With
End Sub