Excel filtering rows based on multiple criteria

Question

Lets say i have a named range in excel. It has links to recipes in column A. Adjacent columns have some more information on the recipe.

For instance column B has 'Ingredients', column C has 'Kitchen utensils needed', column D has 'Course'.

In all cells of columns B and further there may be multiple entries, in random order, separated by comma's. E.g. for apple pie the ingredients would be 'Apple, butter, egg, sugar'. Kitchen utensils could 'oven, pie-container, mixing-machine'

I made some multiple select listboxes in which all possible ingredients are listed, all possible utensils are listed, etc. I want to use the listboxes to filter out the appropriate recipes.

Now the autofilter can only filter up to two words at the same time for one specific column. I want to be able to look up any amounts of ingredients at the same time. All recipes having any of the selected ingredients must show up, even if i select 10 ingredients.

There is also the advanced filter, however because i have multiple columns (10 for the actual data which is not recipes) and want to be able to select up to 10 (more or less) search values per column, the amount of combinations that i need to supply for the advanced filter quickly grows out of control.

Any thoughts on how to achieve this in VBA?

So all rows where Column A contains (x or y or z or ...) AND Column B contains (f or g or h or ...) AND column C contains (q or p or r or ...), etc.

It's quite easily written down in one sentence here, but I'm a bit lost at making the translation to VBA code for the filtering. I do have the selected values of the listboxes in a dict.

Answer 1

I figured it would make sense to post my alterations and some additional functions i used based on the answer by user3964075.

main filtering routine custom_filter:

Sub custom_filter()

Dim test_row As Range
Dim row_hidden As Boolean
Dim keywords As String
Dim ListBox As Object
Dim col_index As Integer
Application.ScreenUpdating = False

'replace named_range with appropriate name
For Each test_row In ThisWorkbook.Names("named_range").RefersToRange.Rows
  row_hidden = True

  'test first column - fill a regex search string with selected words
  Set ListBox = Sheets("SheetWithListboxes").Shapes("ListBoxIngredients").OLEFormat.Object
  keywords = getkeywords(Listbox)

  col_index = 1  'assign column number inside the named range

  If test_column(test_row.Cells(1, col_index).Value, keywords) Then

    'test second column - fill the regex search string with selected words
    Set ListBox = Sheets("SheetWithListboxes").Shapes("ListBoxUtensils").OLEFormat.Object
    keywords = getkeywords(Listbox)
    col_index = 2  'assign column number inside the named range

    If test_column(test_row.Cells(1, col_index).Value, keywords) Then
      'test third column - etc, nest more conditions if needed
      row_hidden = False
    End If
  End If

  test_row.EntireRow.hidden = row_hidden

Next

Application.ScreenUpdating = True

End Sub

Function getkeywords to obtain the selected (possible multiple) entries in a listbox

Public Function getkeywords(ListBox As Object) As String

    Dim i, j As Integer

    With ListBox.Object
        For i = 0 To .ListCount - 1
            If .selected(i) Then
                If LCase(.List(i)) = "all" Then 
                    'if "all" is selected then ignore any other selection, return an empty search string
                    getkeywords = ""
                    Exit For
                End If
                If j = 0 Then
                    getkeywords = .List(i) 'First selected, just add
                Else
                    getkeywords = getkeywords + "|" + .List(i) 'any additional selections are appended with the or operator |
                End If
                j = j + 1
            End If
        Next i
    End With    
End Function

Function test_column to do the regex search for the selected word(s) in the cell:

Public Function test_column(LookIn As String, LookFor As String) As Boolean

  Set RE = CreateObject("VBScript.RegExp")
  RE.IgnoreCase = True
  RE.Pattern = LookFor
  RE.Global = False

  If RE.Test(LookIn) Then
    test_column = True
  End If

End Function

Answer 2

You can manually set the visibility of each row.

Sub custom_filter()

Dim test_row As Range
Dim row_hidden As Boolean
Dim keywords() As String
Dim col_index As Integer
Application.ScreenUpdating = False

'replace named_range with appropriate name
For Each test_row In ThisWorkbook.Names("named_range").RefersToRange.Rows
  row_hidden = True

  'test first column - fill the array with you words
  ReDim keywords(2) As String
  keywords(0) = "apple"
  keywords(1) = "orange"
  keywords(2) = "cheese"
  col_index = 2  'assign column number inside the named range

  If test_column(test_row.Cells(1, col_index).Value, keywords) Then

    'test second column - fill the array with you words
    ReDim keywords(1) As String
    keywords(0) = "spoon"
    keywords(1) = "fork"
    col_index = 3  'assign column number inside the named range

    If test_column(test_row.Cells(1, col_index).Value, keywords) Then
      'test third column - fill the array with you words
      ReDim keywords(2) As String
      keywords(0) = "v1"
      keywords(1) = "v2"
      keywords(2) = "v3"
      col_index = 4  'assign column number inside the named range
      If test_column(test_row.Cells(1, col_index).Value, keywords) Then
        'nest more conditions if needed
        row_hidden = False

      End If
    End If
  End If

  test_row.EntireRow.hidden = row_hidden

Next

Application.ScreenUpdating = True

End Sub

The test_column function may look like that:

Function test_column(col_value As String, keywords() As String) As Boolean

test_column = False
For i = LBound(keywords) To UBound(keywords)
  If InStr(1, col_value, keywords(i), vbTextCompare) Then
    test_column = True
    Exit Function
  End If
Next
End Function