Search for Similar? - VBA

[JazzSP8]

Hi All

I'm hoping someone here can help me, or point me in the right direction.

I've got a macro that searches through one work sheet for a string and then pulls out all the information into another sheet. I use it to identify searches that have been made on a website and it allows me to check for related searches to a degree, such as if someone searched for 'note pad' I could bring back the result with just searching for 'pad'.

I have a few problems; First being, I have spelling mistakes that I would like to be brought back into the sheet as well. For example if someone searches for 'catlogue' I'd like to match it to 'catalogue' if I entered that as a search string.

Also, just as it works well when using the 'pad' example above then it also works against me if I'm looking for 'iPod' then I get results that come back with 'Tripod' which can cause me pull loads of redundant data. This also a problem with the above, if I wanted to search for 'Cat' (for the spelling mistakes) then I'd end up with a lot of search strings for Cat 5 /6 cables.

Here's what I've got so far...

Sub BetterSearch()

Application.ScreenUpdating = False

    Dim DestSheet As Worksheet
    Dim sRow, dRow As Long
    Dim SearchFor As String
    
SearchFor = UCase(Worksheets("Search").Range("B4"))

If WorksheetFunction.CountA(Range("A:A")) = 0 Then
    MsgBox "No data to search through..."
    Exit Sub
End If

If SearchFor = "" Then
    MsgBox "No term to extract..."
    Exit Sub
End If

On Error Resume Next
Set DestSheet = Worksheets(SearchFor)

If DestSheet Is Nothing Then
    Sheets.Add.Name = SearchFor
Else
    MsgBox "That term has already been searched for..."
    Sheets(SearchFor).Select
    Exit Sub
End If
On Error GoTo 0

Set DestSheet = Worksheets(SearchFor)
  
  dRow = 0
  
  For sRow = 1 To Range("B65536").End(xlUp).Row Step 1
     
     If WorksheetFunction.IsError(Cells(sRow, "B")) Then GoTo Skip:
     
     If UCase(Cells(sRow, "B")) Like "*" & SearchFor & "*" Then
        
        dRow = dRow + 1
        Cells(sRow, "B").Copy Destination:=DestSheet.Cells(dRow, "A")
        Cells(sRow, "D").Copy Destination:=DestSheet.Cells(dRow, "B")
        
        Cells(sRow, "B").Interior.ColorIndex = 6
        Cells(sRow, "D").Interior.ColorIndex = 6
        
        Application.StatusBar = "Checking Row: " & sRow & " of " & Range("B65536").End(xlUp).Row & " for: " & SearchFor & " (" & dRow & ") matches so far."
     End If
Skip:
  Next sRow
  
sRow = sRow - 1
  
If dRow = 0 Then
    Application.StatusBar = "Checked " & sRow & " of " & Range("B65536").End(xlUp).Row & " rows for: " & SearchFor & "  and found " & dRow & " matches."
    MsgBox "Nothing found for " & SearchFor & "."
    Application.DisplayAlerts = False
        Sheets(SearchFor).Delete
    Application.DisplayAlerts = True
Else
    Application.StatusBar = "Checked " & sRow & " of " & Range("B65536").End(xlUp).Row & " rows for: " & SearchFor & "  and found " & dRow & " matches."
    MsgBox dRow & " Results found for " & SearchFor & "."
End If
    
Application.ScreenUpdating = True

End Sub

I don't expect a Google type algorithm or anything but if anyone can suggest something to help improve what I've got then I would be a happy chappy

As always, thanks in advance for anyone that can help

 

[yytsunamiyy]

have a look at alan's UDF for fuzzy matching:

http://www.mrexcel.com/forum/showthread.php?p=955137#974873

see also:

http://www.mrexcel.com/forum/showthread.php?t=69649

 

[JazzSP8]

Thanks for that!

Though, looks like it's a bit beyond me - At least in getting it to work with what I've already got, I might be able to use it if I start from scratch though which is something I could look at doing...

Time to get my learning hat on LOL

 

[yytsunamiyy]

You might be able to use Alan's UDF instead of your sub. Start thinking about entering your search terms in a spreadsheet rather than via an inputbox. As Alan said here

FuzzyVLookup is merely a fuzzy replacement for VLookup, so if you can envisage how you would set out the sheets with VLookup, you can do something similar with FuzzyVLookup.