Macro to convert replace wrong text with right text

Sub SearchReplace()
Dim WS As Worksheet
Dim WBT As Workbook
Dim WST As Worksheet
Dim MaxRow As Long, I As Long, J As Long
Dim cCell As Range
Dim vValues As Variant
Dim sReplace As String, sSearch As String


'---> Set Variables
Set WS = ActiveSheet
MaxRow = WS.Range("A" & WS.Rows.Count).End(xlUp).Row
Set WBT = Workbooks.Open(ActiveWorkbook.Path & "\Text.xlsx")
Set WST = ActiveSheet

For I = 1 To MaxRow
    If WS.Cells(I, "A") <> "" Then
        sSearch = WS.Cells(I, "A")
        vValues = Split(WS.Cells(I, "A"), ";")
        For J = LBound(vValues) To UBound(vValues)
            Set cCell = WST.Range("A:A").Find(what:=vValues(J), LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
            If Not cCell Is Nothing Then
                sReplace = cCell.End(xlDown).Value
                sSearch = Replace(sSearch, vValues(J), sReplace)
            End If
        Next J
        WS.Cells(I, "G") = sSearch
    End If
Next I

WBT.Close False
Set WBT = Nothing
Set WST = Nothing

MsgBox "Search Replace Done !", vbExclamation
End Sub

Select allOpen in new window