Excel VBA to vlookup part of a cell - vba

Question

I want to create a Excel VBA macro that looks for "a123Apple873hhh" and knows that I just wanted to look for "Apple".
It's easier to understand on an example:
On sheet1 I have my fixed table array with a name and its code:
Column A---Column B
12------ --Banana
20-------- Apple
44-------- Orange
On sheet2 I have what I want to look for:
Column A----------Column B
.......... -------ds$$Orange1111aaa
.......... -------22Apple999
.......... -------22Watermelon
.......... -------9q9Orange7ab
etc...
I want a VBA that looks on sheet2/Column B, finds what name is on sheet1/Column B and give its code on sheet2/Column A.
So, the final result is:
Column A------Column B
44 -----------ds$$Orange1111aaa
20 -----------22Apple999
*BLANK* ------22Watermelon
44 -----------9q9Orange7ab
etc...
My code don't work because it just find exact results:
Sub FindCode()
Const COLUMN As String = "E"
Dim i As Long
Dim iLastRow As Long
Dim cell As Range
Dim sh As Worksheet
With ActiveSheet
iLastRow = .Cells(.Rows.Count, COLUMN).End(xlUp).Row
For i = 6 To iLastRow
If .Cells(i, "E") = "" Then
.Cells(i, "A").Value = ""
Else
.Cells(i, "A").Value = Application.VLookup(.Cells(i, "E").Value, Range("etc!A:B"), 2, False)
End If
Next i
End With
End Sub

Answer 1

This code isn't very flexible, and has some game breaking limitations, but it does do what you're asking.
I used the exact same data you provided. Sheet1 look like this:
Sheet2 is as follows:
I used this code
Sub SearchProduct()
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets(1)
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets(2)
Dim fruit As Range: Set fruit = ws1.Range("B2", ws1.Cells(ws1.Rows.Count, "B").End(xlUp))
Dim fruitCode As Range: Set fruitCode = ws2.Range("B2", ws2.Cells(ws2.Rows.Count, "B").End(xlUp))
Dim f As Range, s As Range
For Each s In fruit
For Each f In fruitCode
If InStr(s.Text, f.Text) <> 0 Then
s.Offset(0, -1).Value = f.Offset(0, -1).Value
GoTo SkipTheRest
End If
Next f
SkipTheRest:
Next s
End Sub
Which yielded the following result on Sheet2
Some of the limitations are as follows:
If you have something like Green Apple, it won't find the value because of the Space. This can be easily fixed by using Replace().
If you have something like Watermelon, and another item as Melon, it's going to give the Melon ID # to both. Some fancier coding (a bit of it actually) would be needed to avoid this.
There's a few other issues that may come up depending on the values you're using but they are for the most part small edits to the code. The above two issues (namely 2.) is going to be pretty difficult to avoid..

Answer 2

this should do:
Option Explicit
Sub main()
Dim fruitRng As Range, cell As Range, found As Range
Dim firstAddress As String
With Worksheets("Sheet1")
Set fruitRng = .Range("B1", .Cells(.Rows.Count, 2).End(xlUp)).SpecialCells(XlCellType.xlCellTypeConstants)
End With
With Worksheets("Sheet2")
With .Range("B1", .Cells(.Rows.Count, 2).End(xlUp)).SpecialCells(XlCellType.xlCellTypeConstants)
For Each cell In fruitRng
Set found = .Find(what:=WorksheetFunction.Trim(cell.Value), lookat:=xlPart, LookIn:=xlValues)
If Not found Is Nothing Then
firstAddress = found.Address
Do
found.Offset(, -1).Value = cell.Offset(, -1).Value
Set found = .FindNext(found)
Loop While found.Address <> firstAddress
End If
Next cell
.Offset(, -1).SpecialCells(xlCellTypeConstants, xlTextValues).ClearContents
End With
End With
End Sub