Creteria Help
Hi
Autofilter only lets you filter on two criteria at most. For 3
criteria you need advanced filter.
I'll assume you are selecting your criteria from a multiselect
listbox. If not, this should give you a start
Private Sub OKButton_Click()
Dim Grouplistdata As New Collection
Dim i As Integer, GroupCount As Integer
Dim Item As Variant
Dim GroupCriteria As Range
Application.ScreenUpdating = False
With RegGroups.GroupList
'Get the data in the GroupList ListBox
For i = 0 To .ListCount - 1
'for each Group in the list
If .Selected(i) Then
Grouplistdata.Add .List(i)
End If
Next i
End With
GroupCount = Grouplistdata.Count
'Remove any filter present
With Worksheets("Panel Details")
On Error Resume Next 'required if Advanced filter used
.ShowAllData
On Error GoTo 0
.AutoFilterMode = False 'Removes drop down arrows
End With
Select Case GroupCount
'Check the user hasn't clicked OK on the ViewList userform without
selecting anything
Case 0
Exit Sub 'nothing happens and form is still visible
'Use AutoFilter if GroupCount is 1 or 2
Case 1
Worksheets("Panel Details").Range("A1:IV2500").AutoFilter
Field:=1, Criteria1:=CStr(Grouplistdata(1))
Case 2
Worksheets("Panel Details").Range("A1:IV2500").AutoFilter
Field:=1, Criteria1:=CStr(Grouplistdata(1)), Operator:=xlOr,
Criteria2:=CStr(Grouplistdata(2))
Case Is 2
'Start by inserting a worksheet and creating a Criteria Range to put
into AdvancedFilter
'addSheet first removes the sheet, so it is always a fresh sheet
AddSheet "WorkSpaceSheet" 'now the active sheet
With ActiveWorkbook.Worksheets("WorkSpaceSheet")
.Visible = False
.Cells(1, 1).Value = "Group" 'same as heading on worksheet
for "A", "B", "C",..
i = 1 'set a counter and put group items below "Group"
For Each Item In Grouplistdata
i = i + 1
.Cells(i, 1).Value = Item
Next Item
Set GroupCriteria = .Cells(1, 1).CurrentRegion
End With 'worksheet
'Filter the list
With Worksheets("Panel Details")
.Activate
.Range("A1:IV2500").AdvancedFilter
Action:=xlFilterInPlace, CriteriaRange:=GroupCriteria
End with
End Select
End Sub
regards
Paul
|