Find and replace multiple values in Excel using VBA

[mdmackillop]

A change to the loop exit is required

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)
        With Sh1.Cells
            Set c = .Find(cel, lookat:=xlPart)
            Do Until c Is Nothing
                If Not c Is Nothing Then
                    c.Value = Replace(c, cel, cel.Offset(, 1))
                End If
                Set c = .FindNext(c)
            Loop
        End With
    Next
End Sub