Find and replace multiple values in Excel using VBA

[mdmackillop]

Simplified code

Sub Test()

    Dim Sh1 As Worksheet
    Dim Sh2 As Worksheet
   
    Set Sh1 = Sheets(1)
    Set Sh2 = Sheets(2)
    For Each cel In Sh2.Columns(1).SpecialCells(2)  'Text to find
        With Sh1.Cells   'Text to search
            Set c = .Find(cel, lookat:=xlPart)
            Do
                If Not c Is Nothing Then
                    c.Value = Replace(c, cel, cel.Offset(, 1))
                End If
                Set c = .FindNext(c)
            Loop Until c Is Nothing
        End With
    Next
End Sub