Find first two words in a string and compare to another with VBA

[VorLag]

Hello VBAers,

What I am trying to do isn't very complicated, but I'm having some trouble figuring out how best to do this. I started on some code, but it's just not good enough to do all of what needs to happen.

	A	B	C
1	Cupcake Monster	Aisle 5	Shelf H
2	The Cupcake Ghoul	Aisle 2	Shelf P
3	Fred Baxter's Diary	Aisle 1	Shelf X
4	Angry Cupcake Beast	Aisle 3	Shelf A
5	Everyone Loves Cake	Aisle 4	Shelf R

<tbody>
</tbody>

So I have a list of titles that I want to search for a particular string. The title in this list is the "proper" title, whereas the rest of my workbook typically uses a shortened version of the title. Sometimes the two will match 100%, but usually, they will be close.

If the string in the table above has more than 2 words, I want to use the first 2 words to check for a match. If the string has 2 words (will never have fewer), I want to match the first word. I want to do this IF there is no 100% match (if possible or reasonable). I will settle for just matching 1 or 2 words. I want to copy the values to another sheet and then delete the row that I originally got the data from.

What I want to do is search the list for "Angry Cupcake" and return the Aisle and Shelf location of Angry Cupcake Beast. There will never be any other "Angry Cupcake", so I am not worried about mismatches there.

Dim SearchRow As Integer
Dim StoryTitle As String

StoryTitle = Sheets("Library").Range("A1").Value
SearchRow = 2
While Len(Range("A" & CStr(SearchRow)).Value) > 0
      If Range("A" & CStr(SearchRow)).Value = Trim(StoryTitle) Then
         Range("C" & CStr(SearchRow)).Select
         Selection.Copy
         Sheets("Library").Select
         Range("A2").Select
          Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
         Sheets("Data").Select
         Range("B" & CStr(SearchRow)).EntireRow.Delete
      End If
      SearchRow = SearchRow + 1
   Wend
   Application.CutCopyMode = False

All I really know how to do and can get to work without issues is an exact match. This still leaves out all of the shortened titles though. How can I fix this?

 

[Comfy]

You could use something like this function.

Excel 2010
	A	B	C
1	Cupcake Monster	Aisle 5	Shelf H
2	The Cupcake Ghoul	Aisle 2	Shelf P
3	Fred Baxter's Diary	Aisle 1	Shelf X
4	Angry Cupcake Beast	Aisle 3	Shelf A
5	Everyone Loves Cake	Aisle 4	Shelf R
6
7
8
9
10
11
12	Search Term	Aisle	Shelf
13	Cupcake Beast	Aisle 3	Shelf A
Sheet1

Public Function FindAisle(SearchTerm As String, titlerng As Range, Aislerng As Range, Shelfrng As Range, ReturnItem As Integer) As String


Dim c As Range


For Each c In titlerng.Cells
    If c.Value Like "*" & Replace(SearchTerm, " ", "*") & "*" Then
        Select Case ReturnItem
            Case Is = 0
                FindAisle = c.Offset(0, Aislerng.Column - 1).Value
            Case Is = 1
                FindAisle = c.Offset(0, Shelfrng.Column - 1).Value
        End Select
        Exit Function
    End If
Next c


End Function

 

[VorLag]

You could use something like this function.

I'm not following how to use it. Do I just call the function in my macro or do I need to paste it in there? My VBA skills take me only so far at this stage. :S

 

[Comfy]

You should paste the code into a VBA module, so in one of its own or in the same module as your other code.

After reading your message in full I think you should use this:

Public Function FindTitle(SearchTerm As String, titlerng As Range) As Range




Dim c As Range




For Each c In titlerng.Cells
    If c.Value Like "*" & Replace(SearchTerm, " ", "*") & "*" Then
        Set FindTitle = c
        Exit Function
    End If
Next c




End Function
Sub MoveTitles()


Dim Found As Range


Set Found = FindTitle("monkey", Range("A1:A5"))


If Not Found Is Nothing Then
'The rest of your code for moving the item
End If


End Sub