Excel Find & Replace Macro

Question

I have a worksheet which imports all of my orders, however when creating labels, I only have a limited amount of space for the title. I'm using a Find & Replace Macro in Excel which looks in my current active imported worksheet, and replaces with text from another worksheet which I use as a table with 2 columns, Column A is what the title is when imported and Column B is what I want to change it to. This script works perfectly fine except it doesn't find columns that have a different beginning. For example:

Imported Worksheet:

Entry 1: BANANAS

Entry 2: 30 X BANANAS

Table:

Column A: BANANAS

Column B: Yellow Bananas

//Script Runs//

Output: Imported Worksheet:

Entry 1: Yellow Bananas

Entry 2: 30 X BANANAS

As you can see in the example above, the "30 X BANANAS" entry does not change to "30 X Yellow Bananas", as I would want it to. I'm guessing I need to add a wildcard line of code to my script below, but I'm not sure how to incorporate it?

Sub FindReplace()
  Dim s As String
  Dim cell As Range
  For Each cell In Range("H3:H5000").Cells
    If cell <> "" Then
      ans = Application.VLookup(cell, Sheets("Script").Range("A1:B1000"), 2, 0)
      If Not IsError(ans) Then cell = ans
    End If
  Next cell
End Sub

Answer 1

If you use the Range.Replace function rather than the VLookup function, you will get the result you are looking for.

Before

After

Sub FindNReplace()
Dim InputRng As Range, ReplaceRng As Range

'Set Range Values
Set InputRng = Range("A1:A5")
Set ReplaceRng = Sheets("Script").Range("A1:B100")

'Spin through replacement range and perform replace
For Each Rng In ReplaceRng.Columns(1).Cells
    InputRng.Replace what:=Rng.Value, replacement:=Rng.Offset(0, 1).Value
Next
End Sub