Filtering Data By Multiple Criteria On Userform

Filtering Data By Multiple Criteria

       
         ◾ An advanced example about VBA filtering.

We can filter on userform with combo boxes according to multiple criteria in this template .

Also can be filtered between columns according to many operators (=, >, >=, <, <=) comparison.

Codes of Filter button :

Private Sub CommandButton1_Click()
Dim strOperator1 As String, strOperator2 As String
Dim rCell As Range
With Sheet2
On Error Resume Next
.Range("CriteriaData").ClearContents
.Range("Z1:AD100").Clear

If Dand.Value = True Then
If D1.ListIndex > -1 Then .Range("B4") = "=" & """" & D1.Value & """"
If D2.ListIndex > -1 Then .Range("C4") = "=" & """" & D2.Value & """"
Else
If D1.ListIndex > -1 Then .Range("B4") = "=" & """" & D1.Value & """"
If D2.ListIndex > -1 Then .Range("B5") = "=" & """" & D2.Value & """"
End If

If Qand.Value = True Then
If Q1.ListIndex > -1 Then .Range("D4") = Q1C & Q1.Value
If Q2.ListIndex > -1 Then .Range("E4") = Q2C & Q2.Value
Else
If Q1.ListIndex > -1 Then .Range("D4") = Q1C & Q1.Value
If Q2.ListIndex > -1 Then .Range("D5") = Q2C & Q2.Value
End If

strOperator1 = UBDC1
strOperator2 = UBDC2

If strOperator1 = "=" Then strOperator1 = ""
If strOperator2 = "=" Then strOperator2 = ""

If UBDand.Value = True Then
If IsDate(UBD1) Then .Range("F4") = strOperator1 & UBD1.Value
If IsDate(UBD2) Then .Range("G4") = strOperator2 & UBD2.Value
Else
If IsDate(UBD1) Then .Range("F4") = strOperator1 & UBD1.Value
If IsDate(UBD2) Then .Range("F5") = strOperator2 & UBD2.Value
End If

If Land.Value = True Then
If L1.ListIndex > -1 Then .Range("H4") = "=" & """" & L1.Value & """"
If L2.ListIndex > -1 Then .Range("I4") = "=" & """" & L2.Value & """"
Else
If L1.ListIndex > -1 Then .Range("H4") = "=" & """" & L1.Value & """"
If L2.ListIndex > -1 Then .Range("H5") = "=" & """" & L2.Value & """"
End If

If ACand.Value = True Then
If AC1.ListIndex > -1 Then .Range("J4") = "=" & """" & AC1.Value & """"
If AC2.ListIndex > -1 Then .Range("K4") = "=" & """" & AC2.Value & """"
Else
If AC1.ListIndex > -1 Then .Range("J4") = "=" & """" & AC1.Value & """"
If AC2.ListIndex > -1 Then .Range("J5") = "=" & """" & AC2.Value & """"
End If

If WorksheetFunction.CountA(Range("FisrtRowCriteria")) > 0 Then
For Each rCell In Range("SecondRowCriteria")
If IsEmpty(rCell) And rCell.Offset(-1, 0) <> "" Then
rCell = rCell.Offset(-1, 0)
End If
Next rCell

If WorksheetFunction.CountA(Range("SecondRowCriteria")) > 0 Then
.Range(.Range("A4").End(xlToRight).Offset(-1, 0), _
.Range("L5").End(xlToLeft)).Name = "FilterCriteria"
Else
.Range(.Range("A4").End(xlToRight).Offset(-1, 0), _
.Range("L4").End(xlToLeft)).Name = "FilterCriteria"
End If

Range("Data_Table_With_Heads").AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=Range("FilterCriteria"), CopyToRange:=.Range("Z1")
.Range("Z1").CurrentRegion.Offset(1, 0).Name = "Filtered_Data"
ListBox2.RowSource = ""
ListBox2.RowSource = "Filtered_Data"
End If
End With

On Error GoTo 0
End Sub