Creating Filters with UserForms, List Boxes and Command Buttons

[Argonath]

What modifications do I need to make to the following code to filter column-based data fields in an Excel spreadsheet? The List Boxes (ListBox1 and ListBox2) are the data elements to be selected in columns named "Column_X_Data" and "Column_2_Data", respectively.

The data looks like:



Column X Column Y
-------- --------
ABC123 DEF143
ACB123 FED134
. .
. .
. .
{alphanumeric data Col.X} {alphanumeric data for Col.Y}



For example, "Column_X_Data" is the name of cells A2 to A65536 and "Column_Y_Data" is the name of cells B2 to B65536 (or any other valid cell range for a column). "Column_X_and_Y_Data" is, for example, cell range A2 to B65536.

Here is the code I have now:
-----------------------------------------------------------

Private Sub CommandButton1_Click()
Dim 1Count As Integer

On Error Resume Next
With Sheet1
.AutoFilterMode = False
.Range("Column_X_and_Y_Data").AutoFilter Field:=1,Criteria1:="ABC123",Operator:=xlAnd,Criteria2:="DEF143"
lCount = Range("Column_X_and_Y_Data").SpecialCells(xlCellTypeVisible).Count - 1
End With
MsgBox "There are " & lCount & " rows that have ABC123 and DEF143", vbInformation
On Error GoTo 0

End Sub

Private Sub CommandButton2_Click()

End Sub

Private Sub USerForm_Initialize()
Dim Column_X_List As Variant, i As Long
With Me.ListBox1
.Clear ' clear the listbox content
Column_X_List = UniqueItemList(Range("Column_X_Data"),True)
For i = 1 to UBound(Column_X_List)
.AddItem Column_X_List(i)
Next i
.ListIndex = 0 ' select the first item
End With

Dim Column_Y_List As Variant, j As Long
With Me.ListBox2
.Clear ' clear the listbox content
Column_Y_List = UniqueItemList(Range("Column_Y_Data"),True)
For j = 1 to UBound(Column_Y_List)
.AddItem Column_Y_List(j)
Next j
.ListIndex = 0 ' select the first item
End With
End Sub

Private Function UniqueItemList(InputRange As Range, HorizontalList As Boolean)
Dim cl As Range, cUnique As New Collection, i As Long, uList() As Variant
Application.Volatile
On Error Resume Next
For Each cl In InputRange
If cl.Formula <> "" Then
cUnique.Add cl.Value, CStr(cl.Value)
End If
Next cl
UniqueItemList = ""
If cUnique.Count > 0 Then
ReDim UList(1 To cUnique.Count)
For z = 1 To cUnique.Count
uList(z) = cUnique(z)
Next z
UniqueItemList = uList
If Not HorizontalList Then
UniqueItemList = Application.WorksheetFunction.Transpose(UniqueItemList)
End If
End If
On Error GoTo 0
End Function

-----------------------------------------------------------

Example of how the code is supposed to work:

(1) If Column X has data elements "ABC123", "ACB132", and "CBA123", etc. and Column Y has data elements "DEF123", "DEF132", "DFE213", etc., when you run the macro, a UserForm comes up with two ListBoxes (ListBox1 and ListBox2). ListBox1 contains "ABC123", "ACB132", "CBA123", etc. and ListBox2 contains "DEF123", "DEF132", "DFE213", etc.

(2) If "ABC123" and "DFE213" are selected from ListBox1 and ListBox2, respectively, press CommandButton1 and the Excel Worksheet (containing the data) will filter to only show rows containing "ABC123" and "DFE213".

This appears to be a relatively simple filter using a single UserForm with two ListBoxes and two CommandButtons that counts instances of the filtered elements - any help is much appreciated!

 

[PHV]

Replace this:
.Range("Column_X_and_Y_Data").AutoFilter Field:=1,Criteria1:="ABC123",Operator:=xlAnd,Criteria2:="DEF143"
with this:
.Range("Column_X_and_Y_Data").AutoFilter Field:=1, Criteria1:="ABC123"
.Range("Column_X_and_Y_Data").AutoFilter Field:=2, Criteria1:="DEF123"


Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886