excelvbafilterautofilter

how to don an "Or" filter with VBA?

I am currently trying to filter several columns of my Excel sheet depending on which parameters have been selected (they are written in Textox in an UserForm). I want to apply an "Or" on these parameters: for example, I want to show the line where it's written "2012" but also the line where it's written "Process" even though they both are not in the same line. I can only apply an "And" filter at the moment, my "Or" is not working. I tried to use the "Operator = xlOr" but it strangely operates like an "and"

Can you help me, please? I'm stuck since 1 week ago and it's the only parameter missing to finish a project. Thank you!

Private Sub CommandButtonRecherche_Click()

'----------- Création des filtres

    'Déclaration des variables pour les filtres
    Dim strFilter1 As String, strFilter2 As String, strFilter3 As String, strFilter4 As String, strFilter5 As String, strFilter6 As String, strFilter7 As String, strFilter8 As String
    
    'Obtient les valeurs saisies dans les textboxes associés à chaque colonne
    strFilter1 = TextBoxComm.Value
    strFilter2 = TextBoxMach.Value
    strFilter4 = TextBoxClt.Value
    strFilter5 = TextBoxProj.Value
    strFilter6 = TextBoxDT.Value
    strFilter8 = ComboBoxPb.Value
    strFilter3 = TextBoxMotCle1.Value
     
    
    'Définit le champ et le critère de chaque filtre
    Dim field1 As Long, criteria1 As String
    Dim field2 As Long, criteria2 As String
    Dim field3 As Long, criteria3 As String
    Dim field4 As Long, criteria4 As String
    Dim field5 As Long, criteria5 As String
    Dim field6 As Long, criteria6 As String
    Dim field8 As Long, criteria8 As String
    Dim field7 As Long, criteria7 As String
    Dim field9 As Long, criteria9 As String 'toggle button

    Call Clear_Filters

     If strFilter1 <> "" Then 'Numéro de commande
       field1 = 4 'Champ de la colonne associé au premier textbox
       criteria1 = "*" & strFilter1 & "*" 'Critère pour filtrer la colonne associé au premier textbox
       
       ReDim Preserve T1(x)
       ReDim Preserve T2(x)
       T1(x) = field1 'ajout le premier champs au tableau T1
       T2(x) = criteria1 'ajout du premier critère de filtre au tableau T2
       x = x + 1
       
    End If
    

    If strFilter2 <> "" Then 'Machine
        field2 = 3
        criteria2 = "*" & strFilter2 & "*"
        
       ReDim Preserve T1(x)
       ReDim Preserve T2(x)
       T1(x) = field2
       T2(x) = criteria2
       x = x + 1
    End If
    

    If strFilter3 <> "" Then 'Mot Clé
       If CheckBoxMot.Value = True Then 'l'utilisateur choisi si il veut appliquer sa recherche sur le champs mot clé ou sur le champ de description complète
           field3 = 8
       Else
           field3 = 5
       End If
       criteria3 = "*" & strFilter3 & "*"

       ReDim Preserve T1(x)
       ReDim Preserve T2(x)
       T1(x) = field3
       T2(x) = criteria3
       x = x + 1
     End If
       
       
     If strFilter4 <> "" Then 'Client
       field4 = 10
       criteria4 = "*" & strFilter4 & "*"

       ReDim Preserve T1(x)
       ReDim Preserve T2(x)
       T1(x) = field4
       T2(x) = criteria4
       x = x + 1
     End If

    If strFilter5 <> "" Then 'Projet
        field5 = 11
        criteria5 = "*" & strFilter5 & "*"
        
       ReDim Preserve T1(x)
       ReDim Preserve T2(x)
       T1(x) = field5
       T2(x) = criteria5
       x = x + 1
    End If


    If strFilter6 <> "aaaa" Then 'Date
        field6 = 9
        criteria6 = "*" & strFilter6 & "*"
        
       ReDim Preserve T1(x)
       ReDim Preserve T2(x)
       T1(x) = field6
       T2(x) = criteria6
       x = x + 1
     End If


    If strFilter8 <> "Sélectionnez le type de problème" Then
        field8 = 7
        criteria8 = "*" & strFilter8 & "*"
 
       ReDim Preserve T1(x)
       ReDim Preserve T2(x)
       T1(x) = field8
       T2(x) = criteria8
       x = x + 1
    End If
    
    
     If OptionButtonOui.Value = True Then
        field9 = 13
        criteria9 = "OUI"
 
       ReDim Preserve T1(x)
       ReDim Preserve T2(x)
       T1(x) = field9 'ajout le premier champs au tableau T1
       T2(x) = criteria9 'ajout du premier critère de filtre au tableau T2
       x = x + 1
    End If

    ' Déclaration des variables pour stocker les valeurs des filtres
    Dim T1Values As String
    Dim T2Values() As String
    Dim i As Long
    
    ' ...
    
    ' Ajouter les valeurs de T1 à la chaîne respective
    For i = LBound(T1) To UBound(T1)
        T1Values = T1Values & T1(i) & vbCrLf
    Next i
    
    ' Déterminer le nombre total de critères dans T2
    Dim totalCriteria As Long
    totalCriteria = UBound(T2) - LBound(T2) + 1
    
    ' Créer un tableau de filtres pour le filtre "OU"
    Dim filterArray() As String
    ReDim filterArray(1 To totalCriteria)
    
    ' Ajouter les critères de T2 au tableau de filtres
    For i = LBound(T2) To UBound(T2)
        filterArray(i - LBound(T2) + 1) = T2(i)
    Next i
    
    ' Appliquer le filtre "OU" avec les critères de T2
    With ThisWorkbook.Worksheets("Base de données").ListObjects("RCA").Range
        .AutoFilter Field:=T1, Criteria1:=filterArray, Operator:=xlFilterValues
    End With

at the moment the filter only apply the first criteria in T2 to my sheet

At the moment the filter only apply the first criteria in T2 to my sheet. When I'm trying to change it it the apply like an "and "

Solution

  • When the criteria are complex... then you need to use an auxiliary column and a "custom criteria" Function. I prepared an example:

    Put the Public Function and Public Sub in a Module In this module have read the values selected by the user, in variables, eg:

       strFilter1 = TextBox1.value '==> "BB"
   strFilter2 = TextBox2.value '==> "2"
   strFilter3 = TextBox3.value '==> "YES"


Public Function customCriteria(r As Range, changesMade as Range) As Boolean
 'r is the first cell of a line in the table (first column of line)
 'r.Offset(, 1) is the second column
 'r.Offset(, 2) is the third column
 'In the sheet i named a cell "CHANGES", where write the time with the function now() 
'on every change in the table DATA or the user parameters via the change events. 
'This will update the criteria column to be ready for filtering. 
'This cell pass as the second parameter in customCriteria Function.   
'The criteria logic in my example is: Check if (column 1 contains "BB" AND (column 2 equals "2" OR column 3 equals "YES"))
   'Be careful if the value of cell is aritmetic or string to do the right type comparisons
   'in this example the: r.Offset(, 1).value & "" makes the value a string to compare with "3"
   customCriteria = r.value Like "*" & strFilter1 & "*" And (r.Offset(, 1).value & "" = strFilter2 Or r.Offset(, 2).value = strFilter3)
End Function


Public Sub No_Filters(ByRef tbl As ListObject)
   With tbl
      If .AutoFilter.FilterMode Then
         .AutoFilter.ShowAllData
      End If
   End With
End Sub


Put the commandButton click events in the SHEET module

Private Sub CommandButtonRecherche_Click()
   Call No_Filters(Me.ListObjects("RCA"))
   Me.ListObjects("RCA").Range.AutoFilter Field:=4, Criteria1:="TRUE"
End Sub

Private Sub CommandButton_pas_de_filtres_Click()
   Call No_Filters(Me.ListObjects("RCA"))
End Sub

    Then you filter the data by the Column CRITERIA, clicking the Button "Recherche"