Solved Need to search a list of text in excel by multiple criteria.

Microsoft Excel 2010 - complete product...
July 4, 2012 at 16:03:40
Specs: Windows 7, i5
need help searching/filtering a list of text values in excel, using multiple wildcard criteria, and return all matches.

http://www.computing.net/answers/of...

this is very close to what i need, except that i require all matches returned, not just the first match.

ideally i have a sheet with a criteria list (search keywords) that i can quickly change, and a sheet that the returned data is output to, like the above example.

any help is greatly appreciated, my experience with excel is limited and vba nonexistant but i can figure it out pretty fast.

** all data to be filtered is multiple word text, approx 10k-20k rows, 10 columns of additional data to be retrieved. criteria are multiple word text with wildcards, max 50 search criteria terms**
eg.

List to be filtered:
Pony
Red Pony
Little Red Pony Playset
Pony Playsets
M16 recievers
#2 pencils
Dollar Store Michigan
Red Pony Inn
Pony Shoes

Search Criteria:
*red pony*
*pony*
*pencils
*shoes
*shoes*
*red*

lastly returned data should be in order of the search criteria, ie all red pony first, then all pony, then pencils... or, an identifier appended so that i can sort afterwards.

thanks for any help


See More: Need to search a list of text in excel by multiple criteria.

Report •


#1
July 5, 2012 at 07:36:22
✔ Best Answer
The code below will give you what you asked for.

I assume you are aware that searching for *pony* is going to find any cell that contains a value where that string is found.

Therefore, you are going to have repeats in your list of found items. i.e. searching for *red pony* will return cells containing "red pony" as will searching for *pony*.

The code will return a list that looks like this:

Red Pony
Little Red Pony Playset
Red Pony Inn
Pony
Red Pony
Little Red Pony Playset
Pony Playsets
Red Pony Inn
Pony Shoes
#2 pencils
Pony Shoes
Pony Shoes
Red Pony
Little Red Pony Playset
Red Pony Inn


If that's what you want, then this code will do it with the following assumptions:

Sheet1 Column A contains your "List to be filtered" with Column Headings in Row 1.

Sheet2 Column A contains your "Search Criteria:" with Column Headings in Row 1.

The results will be placed in Sheet3 with the Column Headings from Sheet1 in Row 1.

Option Explicit
Sub MultipleFinder()
Dim srchLen, myString, nxtRw As Integer
Dim firstAddress As String
Dim c As Range
'Clear Sheet 3 and Copy Column Headings from Sheet 1
 Sheets(3).Cells.ClearContents
 Sheets(1).Rows(1).Copy Destination:=Sheets(3).Rows(1)
'Determine length of Search Criteria Column from Sheet2
   srchLen = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
'Loop through list in Sheet2, Column A. As each value is
'found in Sheet1, Column A, copy it to the next row in Sheet3
  With Sheets(1).Columns("A")
    For myString = 2 To srchLen
      Set c = .Find(Sheets(2).Range("A" & myString), lookat:=xlWhole)
        If Not c Is Nothing Then
         firstAddress = c.Address
          Do
            nxtRw = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row + 1
            c.EntireRow.Copy Destination:=Sheets(3).Range("A" & nxtRw)
            Set c = .FindNext(c)
          Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    Next
  End With
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#2
July 5, 2012 at 13:16:12
thanks a ton derby, i will check it out and post back with my results.

yes i realise it will duplicate results, i have this functionality right now in access but it takes minutes to populate the list, im hoping that this excel macro can do it alot faster. i just couldnt get it to return multiple results no matter how many times i rewrote the code i found, needed some pro help. ;)

as for the duplicates all i need is a way to tell which search criteria triggered the result, then i can sort on that and remove duplicates. hopefully ill figure that out on my own.


Report •

#3
July 5, 2012 at 13:27:51
sweeeeeet

its populating a list of 10k rows in ~10 seconds, much much more usable. also the results are populated in order of the search criteria entered, so thats even better, this is basically useable as is for my purposes.

had to change xlWhole to xlPart for anyone referencing this. i will post the whole code when i am done if i make anymore changes to it.

thanks again derby.


Report •

Related Solutions

#4
July 5, 2012 at 14:00:38
re: "i just couldnt get it to return multiple results no matter how many times i rewrote the code i found.

Unfortunately, for some unknown reason, they took the .Find, .FindNext example out of the VBA Help files in versions after 2003. Here's the Help file I start with whenever writing code to find multiple values.

This example finds all cells in the range A1:A500 that contain the value 
2 and changes their values to 5.

<pre>
With Worksheets(1).Range("a1:a500")
    Set c = .Find(2, lookin:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Value = 5
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
		

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#5
July 5, 2012 at 14:15:10
*edit* got the identifier working, will update with full code later, adding more features.*

ya thats the other bit of code i was working with.

honestly i tried the exact code you provided yesterday, along with many other iterations, but there must have been an error in it somewhere, or i didnt realise i had output the results i wanted. (tired)

i just opened up a random file from yesterday, removed a c.Value, 2 backspaces, and our codes match. and now it works.

*all i need it to do now to be perfect is add an identifier (#) to the output to tell me which search criteria word triggered the match. or just add the search criteria word in a column on the output.*

you can see how much i know about vba right here --^ im trying to figure it out myself right now, but if anyone knows how to do it plz tell us.


Report •

#6
July 14, 2012 at 16:25:30
ok i have it all working now, tips for ppl trying to figure this stuff out: make new macros with examples you find and get them working before trying to add them to your main macro, if your trying to get an all-in-one solution.

heres my full code so far, it does alot of stuff, thanks again to derby for the help and i will update this post with any further changes i make again.

Option Explicit
Sub GeneFinder()
Dim srchLen, srchLen2, gName, nxtRw As Integer
Dim g, c, cell As Range
Dim firstAddress As String
'Clear Sheet 2 and Copy Column Headings
 Sheets(2).Cells.ClearContents
 Sheets(1).Rows(1).Copy Destination:=Sheets(2).Rows(1)
'Determine length of Search Columns from Sheet3, Sheet1
   srchLen = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row
   srchLen2 = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
'set all values in sheet1 column q to 0
For Each cell In Sheets(1).Range("q2:q" & srchLen2)
        cell.Value = 0
Next
'this is where all the fancy stuff happens, its searching for matches in sheet1 from
'a list of search keywords in sheet3, and returning the matched values and
'respective rows on sheet2.
'its also adding a new row with the search term which caused the match, and
'color coding it for simple visual reference.
'then its setting the values in sheet1 column q to 1 if a match was made
'and allowing the processor some time to run your other applications
  With Sheets(1).Columns("a")
    For gName = 2 To srchLen
      Set g = .Find(Sheets(3).Range("A" & gName), lookat:=xlPart)
        If Not g Is Nothing Then
            firstAddress = g.Address
                Do
                    nxtRw = Sheets(2).Range("a" & Rows.Count).End(xlUp).Row + 1
                    g.EntireRow.Copy Destination:=Sheets(2).Range("a" & nxtRw)
                    Sheets(2).Range("a" & nxtRw).Offset(0, 16) = Sheets(3).Range("A" & gName)
                    Sheets(2).Range("a" & nxtRw).Offset(0, 16).Interior.ColorIndex = (gName + 10)
                    g.Offset(0, 16) = 1
                    Set g = .FindNext(g)
                    If g.Row Mod 100 = 0 Then    ' If loop has repeated 100 times.
                        DoEvents   ' Yield to operating system.
                    End If
                Loop While Not g Is Nothing And g.Address <> firstAddress
        End If
    Next
  End With
'this part here removes the duplicates from the results we created on sheet 2
'according to the remove duplicates function in excel the array part indicates
'which columns to compare for duplicate records
      Sheets(2).Select
    Columns("A:A").Select
    ActiveSheet.Range("A:Q").RemoveDuplicates Columns:=Array(1, 2, 3, 4), _
        Header:=xlYes
'then this part grabs all the leftovers from our main data set on sheet1
'which did not recieve a match, and copies the rows to our output sheet2.
  With Sheets(1).Columns("q")
    Set c = .Find(0)
        If Not c Is Nothing Then
            firstAddress = c.Address
                Do
                    nxtRw = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1
                    c.EntireRow.Copy Destination:=Sheets(2).Range("A" & nxtRw)
                    Sheets(2).Range("a" & nxtRw).Offset(0, 16) = "nomatch"
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
  End With
End Sub


Report •

#7
July 15, 2012 at 00:00:13
Thanks for sharing.

Here's a tip...

Rarely, if ever, is there a need to Select an object in VBA in order to perform an operation on it. This might make your code just a tad bit more efficient.

If nothing ese, it makes the code easier to read.

Untested...

Sheets(2).Range("A:Q").RemoveDuplicates Columns:=Array(1, 2, 3, 4), _
        Header:=xlYes

You might also want to read this How To.

http://www.computing.net/howtos/sho...

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#8
July 16, 2012 at 16:25:24
What is the correct way to copy a whole sheet to another existing sheet in the same workbook?

id like to have all my data on sheet4, and copy it to sheet1 to be modified by this code each time it runs. unfortunately the only way ive been able to make it work, it copies all the blank cells and has 100s of columns, and excel says it cant do anything cause its out of resources.

if i save the file the blanks go away.

if i try to specify the copy range via srchLen2, it doesnt work with my method.

and thanks for the tip, i checked it out, and that bit of code does work just fine, i edited mine to use your simplified version.


Report •

#9
July 16, 2012 at 16:32:52
Since this s a separate question, it should be asked in its own thread.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#10
November 6, 2012 at 09:12:57
Thanks Jollyburner and DerbyDad03, that was awesome.

Report •

#11
March 6, 2013 at 06:49:04
wanted to post an update, i started working on this project again and i have below a much faster way of accomplishing this goal. as tested thus far its about 10x faster by using the autofilter function instead of a .Find. i chopped together a way to make it wildcard autofilter multiple search criteria and output to another sheet on each pass of the filter.

its still a little bit broken, its double-headering the output, and im losing a single row of data which is duplicate in the field being filtered but has differences in the rest of the columns. for my purposes that is ok, but be aware of this unknown behaviour if you intend to modify this code for your own purposes.

i will be posting a new thread for some help with this new code and i will link it here later.


Report •

#12
March 6, 2013 at 06:51:53
Option Explicit
'the sheets used in my workbook are named as follows:
'(sheet1: Input) (sheet2: Output) (sheet3: Filter) (sheet4: Str)
'there are references to both the names and sheet #s used so be sure to change both if you are trying to use this code.

Sub GeneTiler()
Dim srchLen, keyLen, gName, gName2, nxtRw, nxtRw2 As Integer
Dim g, c, cell As Range
Dim firstAddress As String
'Don't display error if MyDataSheet doesn't exist
  On Error Resume Next
'Don't display confirmation message before deleting sheet
    Application.DisplayAlerts = False
'Delete the MyDataSheet
      Sheets("Input").Delete
'Renable Alerts
    Application.DisplayAlerts = True
'Copy Sheet 4 and rename it
    Sheets("Str").Copy Before:=Sheets(1)
    Sheets("str (2)").Name = "Input"
'Determine length of Search Columns from Sheet3, Sheet1
  keyLen = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row
  srchLen = Sheets(4).Range("A" & Rows.Count).End(xlUp).Row
'Clear Sheet 2 and Copy Column Headings
   Sheets(2).Cells.ClearContents
   Sheets(1).Rows(1).Copy Destination:=Sheets(2).Rows(1)
'searching for matches in sheet1 from
'a list of search keywords in sheet3, and returning the matched values and
'respective rows on sheet2.

Application.DisplayAlerts = False
  With Sheets(1).Columns("a")
    For gName = 2 To keyLen
        If Sheets(3).Range("a1").Value <> "" Then
nxtRw = Sheets(2).Range("a" & Rows.Count).End(xlUp).Row + 1
Sheets("Input").Select
Worksheets("Sheet1").EnableAutoFilter = False
Sheets(1).Range("A:N").AutoFilter Field:=1, Criteria1:="*" & Sheets(3).Range("A" & gName) & "*"
Sheets(1).Range("A:N").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    
    Sheets("Output").Select
    ActiveSheet.Paste Destination:=Sheets(2).Range("a" & nxtRw)
    Sheets("Input").Select
    Sheets(1).Range("A:N").Select
    Selection.SpecialCells(xlCellTypeVisible).Delete
    

Else
Worksheets("Sheet1").EnableAutoFilter = False

End If

 Next

  End With
  Application.DisplayAlerts = True
'this part here removes the duplicates from the results we created on sheet 2
'according to the remove duplicates function in excel the array part indicates
'which columns to compare for duplicate records
nxtRw = Sheets(2).Range("a" & Rows.Count).End(xlUp).Row + 1
nxtRw2 = Sheets(1).Range("a" & Rows.Count).End(xlUp).Row + 1
Sheets(1).Range("A2", ("a" & nxtRw2)).EntireRow.Copy Destination:=Sheets(2).Range("a" & nxtRw)

End Sub


Report •


Ask Question