Using VBA to filter Excel column based on multiple keywords

Using VBA I need a function to filter an Excel spreadsheet based on a string of keywords. The rows need to contain (all) the keywords, but not necessarily in the same order as listed.

There is a previous question/answer that partially addresses this, but it returns the rows that contain (any) of the keywords, not all of them.

I'm searching only column 'B'

Below is the reference to the previous entry for reference.

http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_21740621.html?sfQueryTermInfo=1+10+30+filter+keyword+multipl 
'Credit Webtubbs at above solution

Sub ShowMatches()
     Dim r As Long
     Dim LastRow As Long
     Dim SearchCriteria As String
     Dim arr() As String
     Dim i As Long
     Dim HideRow As Boolean

     SearchCriteria = InputBox("Enter your required Search Criteria" & vbCrLf & _
                               vbCrLf & "[Seperate Search items with a semi-colon ( ; )]")
     If SearchCriteria = "" Then Exit Sub
     Application.ScreenUpdating = False
     arr = Split(SearchCriteria, ";")
     LastRow = [D65536].End(xlUp).Row + 1
     For r = LastRow To 2 Step -1
          For i = LBound(arr) To UBound(arr)
               If InStr(1, Cells(r, "D"), arr(i)) > 0 Then
                    HideRow = False
               End If
          Next
          Rows(r).Hidden = HideRow
          HideRow = True
     Next
     Application.ScreenUpdating = True
End Sub

Open in new window

gedwardnelsonAsked:
Who is Participating?

Improve company productivity with a Business Account.Sign Up

x
 
Rory ArchibaldConnect With a Mentor Commented:
Small reversal of the original logic:
Sub ShowMatchesOrig()
   Dim r                 As Long
   Dim LastRow           As Long
   Dim SearchCriteria    As String
   Dim arr()             As String
   Dim i                 As Long
   Dim HideRow           As Boolean

   SearchCriteria = InputBox("Enter your required Search Criteria" & vbCrLf & _
                             vbCrLf & "[Seperate Search items with a semi-colon ( ; )]")
   If SearchCriteria = "" Then Exit Sub
   Application.ScreenUpdating = False
   arr = Split(SearchCriteria, ";")
   LastRow = Cells(Rows.count, "B").End(xlUp).Row
   For r = LastRow To 2 Step -1
      HideRow = False
      For i = LBound(arr) To UBound(arr)
'         If InStr(1, Cells(r, "B"), arr(i), vbTextCompare) = 0 Then
         If InStr(1, Cells(r, "B"), arr(i)) = 0 Then
            HideRow = True
            Exit For
         End If
      Next i
      Rows(r).Hidden = HideRow
      HideRow = True
   Next
   Application.ScreenUpdating = True
End Sub

Open in new window


Note this is case sensitive. If you don't want that, uncomment the commented line and comment the one below it.
0
 
Michael FowlerSolutions ConsultantCommented:
I made the requested changes to your code but without any data I have not tested it.

I noted that the code you attached was searching column d not B so I have changed that as well.

If the code below does not work could you please provide some sample data to test against

Michael
Sub ShowMatches()
     Dim r As Long, LastRow As Long, i as Long, count as long
     Dim SearchCriteria As String
     Dim arr() As String
     Dim HideRow As Boolean

     SearchCriteria = InputBox("Enter your required Search Criteria" & vbCrLf & _
                               vbCrLf & "[Seperate Search items with a semi-colon ( ; )]")
     If SearchCriteria = "" Then Exit Sub
     Application.ScreenUpdating = False
     arr = Split(SearchCriteria, ";")
     LastRow = Range("B" & rows.count).End(xlUp).row + 1
     For r = LastRow To 2 Step -1
          count = 0
          For i = LBound(arr) To UBound(arr)
               If InStr(1, Cells(r, "B"), arr(i)) > 0 Then count = count + 1
          Next
          if count = UBound(arr) then HideRow = False
          Rows(r).Hidden = HideRow
          HideRow = True
     Next
     Application.ScreenUpdating = True
End Sub

Open in new window

0
 
gedwardnelsonAuthor Commented:
Michael,

Thanks for the quick response. It doesn't appear to search for the second keyword. I have attached a small example of the file.

A couple of examples of what I might be searching for is
2'' X 1'' PVDF REDUCER
or
2'' 316L SS O2 CLEAN TUBING

I might enter something like 2;PVDF and this would list all rows with a "2" AND "PVDF." Or I might enter PVDF;Reducer and get all rows with "PVDF" and "REDUCER", or I might enter 2;SS;Tubing. Or I might just enter a single keyword of "PVDF." Each of these entries might result in more than each of the items listed above but it would narrow down the list significantly, or could actually result in the exact item.

I forgot to mention that this should not be case-sensitive because there hasn't been any consistency in how items were entered.

George
FilterTest.xls
0
 
Michael FowlerConnect With a Mentor Solutions ConsultantCommented:
George

Rorya has nailed it and deserves the points, I just want to see where I went wrong and thought I would post the corrected code

Michael
Sub ShowMatches()
     Dim r As Long, LastRow As Long, i As Long, count As Long
     Dim SearchCriteria As String
     Dim arr() As String
     Dim HideRow As Boolean

     SearchCriteria = InputBox("Enter your required Search Criteria" & vbCrLf & _
                               vbCrLf & "[Seperate Search items with a semi-colon ( ; )]")
     If SearchCriteria = "" Then Exit Sub
     Application.ScreenUpdating = False
     arr = Split(SearchCriteria, ";")
     LastRow = Range("B" & Rows.count).End(xlUp).Row
     For r = LastRow To 2 Step -1
          count = 0
          HideRow = True
          For i = LBound(arr) To UBound(arr)
               If InStr(1, Cells(r, "B").Value, arr(i), vbTextCompare) > 0 Then count = count + 1
          Next
          If count = UBound(arr) + 1 Then HideRow = False
          Rows(r).Hidden = HideRow
     Next
     Application.ScreenUpdating = True
End Sub

Open in new window

0
 
gedwardnelsonAuthor Commented:
Thanks Rorya. That worked exactly as I needed. I made the change you suggested to make it non-case-sensitive.

Michael thanks for your help too. I awarded points to Rorya as you suggested, but I wanted you and anyone else that may be looking at this that your final solution worked too.

George
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.