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.

vba filter

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


4 comments:

  1. how can i increase the number of rows that could be filtered within sheet Data

    ReplyDelete
  2. Can i have the soft copy coz i cant download the file due to PHP error. My email is pandaonly80@gmail.com

    ReplyDelete
    Replies
    1. download the file from this link https://dosya.co/4q0yb5cwaui5/çoklu_filitre_Filter_by_multiple_criteria_(1).xlsm.html

      Delete
  3. https://dosya.co/4q0yb5cwaui5/çoklu_filitre_Filter_by_multiple_criteria_(1).xlsm.html

    ReplyDelete