• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2819
  • Last Modified:

How can i filter data based on multi select Listbox values

Dear All,

I have a listbox placed in the excel sheet attached below in that i can filter records based on listbox selection, but the problem what i am facing is i have to filter records based on multi select

Please help me sorting this problem it will be great help.....
Example.xls
0
sri09
Asked:
sri09
  • 2
1 Solution
 
zivkoCommented:
Hello,

Basically, it depends which version of Excel you use.
In any case, there are many other ways to achieve what you need but to stick on the way you started as close as possible, here it is for both Excel 2003 and 2007:


If you use Excel 2007, then then answer is very easy:

You just need to change (add) the "Operator" in your filter function.
Then you just correct the "Criteria1" to not use the Array function again (To 1:) or you do not need to create your own array (To 2:)

From: Sheet1.Cells.AutoFilter Field:=1, Criteria1:=Array(SelectedItemArr)
To 1: Sheet1.Cells.AutoFilter Field:=1, Criteria1:=SelectedItemArr, Operator:=xlFilterValues
To 2: Sheet1.Cells.AutoFilter Field:=1, Criteria1:=Array(Split(SelectedItemStr, ",")), Operator:=xlFilterValues

So you can simply remove some checks you've made and reduce the whole function to Version 1 in the attached code snipet.
But you'll receive an error when nothing is selected in the list, so try Version 2.

If you use Excel 2003, it's a little bit different:

You won't be able to use AutoFilter to achieve this because Autofilter will accept only two parameters (Criterias), you will be able to select maximum two entries in your list.
Change again the same line in your SUB as follow (the two first selected entries will be used):

From: Sheet1.Cells.AutoFilter Field:=1, Criteria1:=Array(SelectedItemArr)
To  : Sheet1.Cells.AutoFilter field:=1, Criteria1:=SelectedItemArr(0), Operator:=xlOr, Criteria2:=SelectedItemArr(1)

But to be able to select as many entries as you want, you will need to use Advanced Filter functionnalities. You will need to copy the selected list entries into cells (maybe you can do it another way I'm not aware of).

1 - Added some variables
2 - Added a loop to fill the cells with the selected values in the list
3 - Apply Advanced filter using cells values

Here is a quick example (Version 3), still trying to not touch your code too much.
You can past it directly into your example.xls and it should work


Do not forget to include the column names when you use advanced filtering.
So playing arround with this example, you should be able to filter wathever you want.

Hope this will help,
Zivko

PS: Also I attached the modified version of your sample.xls


'----------------------------------------------------------------------------------------
'VERSION 1 (Excel 2007)
'----------------------------------------------------------------------------------------
Sub FilterData()
    Dim SelectedItemStr As String
    Dim ItemCnt As Integer
    
    For ItemCnt = 0 To Sheet1.ListBox1.ListCount - 1
        If Sheet1.ListBox1.Selected(ItemCnt) Then
            SelectedItemStr = SelectedItemStr & Sheet1.ListBox1.List(ItemCnt) & ","
        End If
    Next

    Sheet1.Cells.AutoFilter Field:=1, Criteria1:=Array(Split(SelectedItemStr, ",")), Operator:=xlFilterValues
End Sub


'----------------------------------------------------------------------------------------
'VERSION 2 (Excel 2007)
'----------------------------------------------------------------------------------------

Sub FilterData()
    Dim SelectedItemStr As String
    Dim ItemCnt, SelectedItemCount As Integer

    For ItemCnt = 0 To Sheet1.ListBox1.ListCount - 1
        If Sheet1.ListBox1.Selected(ItemCnt) Then
            SelectedItemCount = SelectedItemCount + 1
            SelectedItemStr = SelectedItemStr & Sheet1.ListBox1.List(ItemCnt) & ","
        End If
    Next

    If SelectedItemCount <= 0 Then Exit Sub
    Sheet1.Cells.AutoFilter Field:=1, Criteria1:=Array(Split(SelectedItemStr, ",")), Operator:=xlFilterValues
End Sub


'----------------------------------------------------------------------------------------
'VERSION 3 (Excel 2003) Using Advanced Filtering
'----------------------------------------------------------------------------------------

Sub FilterData()
    Dim SelectedItemArr
    Dim SelectedItemStr, AdvFilterStr As String
    Dim ItemCnt, SelItemCnt As Integer
    
    For ItemCnt = 0 To Sheet1.ListBox1.ListCount - 1
        If Sheet1.ListBox1.Selected(ItemCnt) Then
            SelectedItemStr = SelectedItemStr & Sheet1.ListBox1.List(ItemCnt) & ","
        End If
    Next
    
    If Len(SelectedItemStr) > 0 Then
       SelectedItemStr = Mid(SelectedItemStr, 1, Len(SelectedItemStr) - 1)
        
       SelectedItemArr = Split(SelectedItemStr, ",")

       Sheet1.Cells(1, 2).Value = "Name" ' Needed for the advanced filter
       For ItemCnt = 0 To UBound(SelectedItemArr)
            Sheet1.Cells(ItemCnt + 2, 2).Value = SelectedItemArr(ItemCnt)
            SelItemCnt = SelItemCnt + 1
       Next

       AdvFilterStr = "B1:B" & SelItemCnt + 1
       Sheet1.Cells.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range(AdvFilterStr), Unique:=False
        
    End If
    
End Sub


'----------------------------------------------------------------------------------------
' END
'----------------------------------------------------------------------------------------

Open in new window

mExample.xls
0
 
sri09Author Commented:
Hi,

Thanks for ur great answer.. it worked like a champ . it will be more greatful for me if u please explain this code....


Sub FilterData()
    Dim SelectedItemArr
    Dim SelectedItemStr, AdvFilterStr As String
    Dim ItemCnt, SelItemCnt As Integer
    
    For ItemCnt = 0 To Sheet1.ListBox1.ListCount - 1
        If Sheet1.ListBox1.Selected(ItemCnt) Then
            SelectedItemStr = SelectedItemStr & Sheet1.ListBox1.List(ItemCnt) & ","
        End If
    Next
    
    If Len(SelectedItemStr) > 0 Then
       SelectedItemStr = Mid(SelectedItemStr, 1, Len(SelectedItemStr) - 1)
        
       SelectedItemArr = Split(SelectedItemStr, ",")

       Sheet1.Cells(1, 2).Value = "Name" ' Needed for the advanced filter
       For ItemCnt = 0 To UBound(SelectedItemArr)
            Sheet1.Cells(ItemCnt + 2, 2).Value = SelectedItemArr(ItemCnt)
            SelItemCnt = SelItemCnt + 1
       Next

       AdvFilterStr = "B1:B" & SelItemCnt + 1
       Sheet1.Cells.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range(AdvFilterStr), Unique:=False
        
    End If
    
End Sub

Open in new window

0
 
zivkoCommented:
Hello,

No Problem but as the changes are minor, the major part is your own code.

Sub FilterData()
    Dim SelectedItemArr
    Dim SelectedItemStr, AdvFilterStr As String
    Dim ItemCnt, SelItemCnt As Integer
    
    ' Create a String containing all the selecte items in the list separated with ","
    For ItemCnt = 0 To Sheet1.ListBox1.ListCount - 1
        If Sheet1.ListBox1.Selected(ItemCnt) Then
            SelectedItemStr = SelectedItemStr & Sheet1.ListBox1.List(ItemCnt) & ","
        End If
    Next
    
    ' Check if String is not empty
    If Len(SelectedItemStr) > 0 Then
       
       ' Remove last character "," (your original code)
       SelectedItemStr = Mid(SelectedItemStr, 1, Len(SelectedItemStr) - 1)
       
       ' Create an Array with the string
       SelectedItemArr = Split(SelectedItemStr, ",")

       ' For advanced filtering, you must use Column names (see Excel Help) so we just create the column label here to ensure it is present
       Sheet1.Cells(1, 2).Value = "Name" ' Needed for the advanced filter
       
       ' Count the number of cells that are part of the advanced filter and store it into "SelItemCnt"
       For ItemCnt = 0 To UBound(SelectedItemArr)
            Sheet1.Cells(ItemCnt + 2, 2).Value = SelectedItemArr(ItemCnt)
            SelItemCnt = SelItemCnt + 1
       Next

       
       ' Set the Advanced filter Cell Range
       AdvFilterStr = "B1:B" & SelItemCnt + 1
       
       ' Apply the Advanced filter on all Sheet cells
       Sheet1.Cells.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range(AdvFilterStr), Unique:=False
        
    End If
    
End Sub

Open in new window

0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now