Macro to find text within string and return value of another cell

Hi,

Let's try this again. My last post didn't have a descriptive title.
Posted for the first time a few days back but got no response. Hopefully I'd be lucky this second time.

I have two workbooks "Vegetables" and "Fruits" Each workbook has the same number of worksheets labeled the same. What I would like to do is develop a macro such that if A2 of Fruits.sheet(2) contains any string found in Vegetables.sheet(2) it returns the cell value B2 of workbook("Vegetables).Sheet(2) into H2 of workbook("Vegetables').Sheet(2). For example
let's say Vegetables sheet(2) has
A B C D
spinach yummy
asparagus delicious
cabbage gross
cauliflower healthy
broccoli okay

and fruits sheet (2) has
A B C D
peaches(spinach)
Grapes-Cauliflower
Broccapples

After I run the code, Fruits sheets should have
A B
peaches(spinach) yummy
Grapes-Cauliflower healthy
Broccapples okay

This is just an example, my data contains a lot of rows. I appreciate any help I can get with this

So I want to do is related to this thread but not exactly
http://www.mrexcel.com/forum/excel-q...ring-text.html
Here is the code:
Sub fnd()
Dim rfirst As Range, r As Range, X As String, LR As Long, response As VbMsgBoxResult
X = InputBox("Name to find?")
Set rfirst = Columns(2).Find(What:=X, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If rfirst Is Nothing Then
MsgBox ("Not found")
Exit Sub
End If
response = MsgBox("Copy " & rfirst.Offset(0, -1).Value & vbTab & rfirst.Value & " ?", vbYesNo + vbQuestion)
If response = vbYes Then
With Sheets("Sheet2")
LR = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A" & LR + 1).Value = rfirst.Offset(0, -1).Value
.Range("B" & LR + 1).Value = rfirst.Value
End With
End If
Set r = Columns(2).FindNext(After:=rfirst)
While (Not rfirst.Address = r.Address)
response = MsgBox("Copy " & r.Offset(0, -1).Value & vbTab & r.Value & " ?", vbYesNo + vbQuestion)
If response = vbYes Then
With Sheets("Sheet2")
LR = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A" & LR + 1).Value = r.Offset(0, -1).Value
.Range("B" & LR + 1).Value = r.Value
End With
End If
Set r = Columns(2).FindNext(After:=r)
Wend

[/SIZE]
The main difference is that instead of using a message box to search for a partial string. I would like for my code to loop through rows of column A of workbook Fruits and find the match in column A of Workbook Vegetables then if a match is found fill column B of Workbook Fruits with corresponding cell value of column B of Workbook Vegetables. Thanks for your help

I don't know how to answer this one, but if you posted this under Excel Programming / VBA / Macros I bet you would get a lot more help.