View Full Version : Filter By Listbox Criteria
mattster1010
08-10-2010, 02:11 AM
Morning All,
I have attached an excel spreadsheet that I'm currently working on. I want the data in 'report criteria' listbox to filter 'sheet1'. at present it's doesn't seem to be working, can anybody give me afew pointers?
Cheers,
Matt
Bob Phillips
08-10-2010, 03:17 AM
Option Explicit
Private Sub CommandButton1_Click()
Dim i As Long, Crit As Long
Dim f As Boolean
For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox2.Selected(i) Then
f = True
Crit = Crit + 1
With Cells(1, 8)
.Value = "CASEPROD SUPPLIER NAME"
.Offset(Crit) = Me.ListBox2.List(i)
End With
End If
Next
If Not f Then
MsgBox "Select items to filter"
Exit Sub
End If
Range("Database").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Range("CritRange"), Unique:=False
Range("CritRange").ClearContents
End Sub
Private Sub ListBox1_Change()
Dim Lastrow As Long
Dim ListIdx As Long
Dim i As Long
ReDim ary(1 To Me.ListBox1.ListCount + 1)
Lastrow = Cells(Rows.Count, "E").End(xlUp).Row
Me.ListBox2.Clear
For i = 2 To Lastrow
If Cells(i, "E").Value2 = Me.ListBox1.Value Then
If IsError(Application.Match(Cells(i, "C").Value2, ary, 0)) Then
ListIdx = ListIdx + 1
ary(ListIdx) = Cells(i, "C").Value2
Me.ListBox2.AddItem Cells(i, "C").Value2
End If
End If
Next i
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ListBox2.AddItem ListBox1.List(ListBox1.ListIndex)
End Sub
Private Sub UserForm_Initialize()
Dim my_strings As Variant
Dim iLoop As Integer
'my_strings = Split("This is a test of ListBox for Ozgrid by Ger", " ")
'For iLoop = LBound(my_strings) To UBound(my_strings)
' ListBox1.AddItem (my_strings(iLoop))
'Next iLoop
End Sub
Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ListBox2.RemoveItem ListBox2.List(ListBox2.ListIndex)
End Sub
Bob Phillips
08-10-2010, 03:37 AM
Here's a better, faster, version
Option Explicit
Private Sub CommandButton1_Click()
Dim i As Long, Crit As Long
Dim f As Boolean
For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox2.Selected(i) Then
f = True
Crit = Crit + 1
With Cells(1, 8)
.Value = "CASEPROD SUPPLIER NAME"
.Offset(Crit) = Me.ListBox2.List(i)
End With
End If
Next
If Not f Then
MsgBox "Select items to filter"
Exit Sub
End If
Range("Database").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Range("CritRange"), Unique:=False
Range("CritRange").ClearContents
End Sub
Private Sub ListBox1_Change()
Dim Lastrow As Long
Dim ListIdx As Long
Dim rng As Range
Dim cell As Range
Dim rngArea As Range
Static fReEntry As Boolean
If Not fReEntry Then
fReEntry = True
ReDim ary(1 To Me.ListBox1.ListCount + 1)
Lastrow = Cells(Rows.Count, "E").End(xlUp).Row
Me.ListBox2.Clear
Set rng = Range("C2:E2").Resize(Lastrow)
rng.AutoFilter Field:=3, Criteria1:=Me.ListBox1.Value
On Error Resume Next
Set rng = rng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then
For Each rngArea In rng.Areas
For Each cell In rngArea.Columns(1)
If IsError(Application.Match(cell.Value2, ary, 0)) Then
ListIdx = ListIdx + 1
ary(ListIdx) = cell.Value2
Me.ListBox2.AddItem cell.Value2
End If
Next cell
Next rngArea
End If
rng.AutoFilter
fReEntry = False
End If
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ListBox2.AddItem ListBox1.List(ListBox1.ListIndex)
End Sub
Private Sub UserForm_Initialize()
Dim my_strings As Variant
Dim iLoop As Integer
'my_strings = Split("This is a test of ListBox for Ozgrid by Ger", " ")
'For iLoop = LBound(my_strings) To UBound(my_strings)
' ListBox1.AddItem (my_strings(iLoop))
'Next iLoop
End Sub
Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ListBox2.RemoveItem ListBox2.List(ListBox2.ListIndex)
End Sub
mattster1010
08-10-2010, 03:58 AM
Hi XLD,
Thanks for the reply. The form needs to work a bit differently. When a user selects a 'customer' from 'listbox1' that customer should appear in 'listbox2' (This currently works). The user could select up to 20 customers that appear in 'listbox2'.
When the user clicks 'Filter' I need the form to close and filter 'Sheet1' by 'CASEPROD SUPPLIER NAME' from the list of customers in 'listbox2'. That's what I'm trying to do, but its not currently working.
Any help you could give would be great.
Cheers,
Matt
mattster1010
08-10-2010, 09:19 AM
Hi Everyone,
Ive turned to a new solution. See attached.
I seem to get any error on the line highligted in red:
Private Sub Filter_Click()
Dim myLB As ListBox
Dim iCtr As Long
Dim DestCell As Range
Dim myCriteria As Range
Dim HowMany As Long
Dim ActWks As Worksheet
Dim ListWks As Worksheet
Set ActWks = Worksheets("sheet1")
Set ListWks = Worksheets("sheet2")
With ListWks
.Range("c:c").Clear
.Range("c1").Value = .Range("A1").Value
Set DestCell = .Range("c2")
End With
With ActWks
Set myLB = .ListBoxes("ListBox1")
With myLB
HowMany = 0
For iCtr = 1 To .ListCount
If .Selected(iCtr) Then
HowMany = HowMany + 1
DestCell.Value _
= "=" & Chr(34) & "=" & .List(iCtr) & Chr(34)
Set DestCell = DestCell.Offset(1, 0)
End If
Next iCtr
End With
If HowMany = 0 Then
MsgBox "Please select at least one item!"
Exit Sub
End If
Set myCriteria = ListWks.Range("c1").Resize(HowMany + 1)
.Range("a:a").AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=myCriteria
End With
End Sub
I can't figure out why?
Regards,
Matt
austenr
08-10-2010, 09:37 AM
Are you sure about the name of that list box? Spaces count. I copied your code to a blank WB, inserted a listbox called "List Box 1" (the default name) and it got past that point.
Bob Phillips
08-10-2010, 10:04 AM
Private Sub Filter_Click()
Dim myLB As OLEObject
Dim iCtr As Long
Dim DestCell As Range
Dim myCriteria As Range
Dim HowMany As Long
Dim ActWks As Worksheet
Dim ListWks As Worksheet
Set ActWks = Worksheets("sheet1")
Set ListWks = Worksheets("sheet2")
With ListWks
.Range("c:c").Clear
.Range("c1").Value = .Range("A1").Value
Set DestCell = .Range("c2")
End With
With ActWks
Set myLB = .OLEObjects("ListBox1")
With myLB
HowMany = 0
For iCtr = 1 To .Object.ListCount
If .Object.Selected(iCtr - 1) Then
HowMany = HowMany + 1
DestCell.Value _
= "=" & Chr(34) & "=" & .Object.List(iCtr) & Chr(34)
Set DestCell = DestCell.Offset(1, 0)
End If
Next iCtr
End With
If HowMany = 0 Then
MsgBox "Please select at least one item!"
Exit Sub
End If
Set myCriteria = ListWks.Range("c1").Resize(HowMany + 1)
.Range("a:a").AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=myCriteria
End With
End Sub
mattster1010
08-10-2010, 12:20 PM
Thanks for both of your inputs. Much appreciated.
The 'filter' button now filters records but doesn't filter the selected records in the listbox correctly. It filters the record underneath the selected record?
Bob Phillips
08-10-2010, 12:57 PM
Well, you wrote the code, I just got it working for you.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.