Autofilter in VBA when criteria is has more words separated by a comma

[shafiey]

Hello, good time
In the following VBA code, the cells: D1, F1 and H1 contain values that are separated by commas, and I want to apply the filter action based on those values in the corresponding column.
Thank you for solving the problem.


VBA code in Sheet (Keywords Analysis):

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strList As String
On Error Resume Next
Application.EnableEvents = False

   Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
   On Error GoTo exitHandler

   If rngDV Is Nothing Then GoTo exitHandler

   If Not Intersect(Target, rngDV) Is Nothing Then
      If Target.Validation.Type = 3 Then

         strList = Target.Validation.Formula1
         strList = Right(strList, Len(strList) - 1)
         strDVList = strList
         frmDVList.Show
      End If
   End If

exitHandler:
  Application.EnableEvents = True

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strSep As String
strSep = ", "
  Application.EnableEvents = False
On Error Resume Next
If Target.Count > 1 Then GoTo exitHandler


Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Intersect(Target, rngDV) Is Nothing Then
   'do nothing
Else

  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
   If newVal = "" Then
      'do nothing
   Else
         If oldVal = "" Then
            Target.Value = newVal
         Else
            Target.Value = oldVal & strSep & newVal
         End If
    End If

End If

exitHandler:
  Application.EnableEvents = True



  If Not Intersect(Target, Range("D1")) Is Nothing Then Filter_namebakhsh Range("D1").Value

  If Not Intersect(Target, Range("F1")) Is Nothing Then Filter_saleshoroo Range("F1").Value

  If Not Intersect(Target, Range("H1")) Is Nothing Then Filter_salekhatameh Range("H1").Value

End Sub

VBA Code in Module:

Sub Filter_namebakhsh(namebakhsh As String)
  Application.Calculation = xlCalculationManual
  With Worksheets("Projects")
    .AutoFilterMode = False
    If Len(namebakhsh) > 0 Then .Range("A1:AQ" & .Cells(.Rows.Count, "AC").End(xlUp).Row).AutoFilter Field:=29, Criteria1:=namebakhsh
  End With
  Application.Calculation = xlCalculationAutomatic
  Worksheets("Keywords Analysis").Activate
  ActiveSheet.PivotTables("PivotTable2").RefreshTable
End Sub

Sub Filter_saleshoroo(saleshoroo As String)
  Application.Calculation = xlCalculationManual
  With Worksheets("Projects")
    .AutoFilterMode = False
    If Len(saleshoroo) > 0 Then .Range("A1:AQ" & .Cells(.Rows.Count, "AF").End(xlUp).Row).AutoFilter Field:=32, Criteria1:=">=" & saleshoroo
  End With
  Application.Calculation = xlCalculationAutomatic
  Worksheets("Keywords Analysis").Activate
  ActiveSheet.PivotTables("PivotTable2").RefreshTable
End Sub

Sub Filter_salekhatameh(salekhatameh As String)
  Application.Calculation = xlCalculationManual
  With Worksheets("Projects")
    .AutoFilterMode = False
    If Len(salekhatameh) > 0 Then .Range("A1:AQ" & .Cells(.Rows.Count, "AG").End(xlUp).Row).AutoFilter Field:=33, Criteria1:="<=" & salekhatameh
  End With
  Application.Calculation = xlCalculationAutomatic
  Worksheets("Keywords Analysis").Activate
  ActiveSheet.PivotTables("PivotTable2").RefreshTable
End Sub