Find and replace multiple values in Excel using VBA

I'm looking for VBA code to run in Excel to find and replace lots of words.
Basically, it will be a simple Excel file where Sheet1 contains phrases in 1 column which contains names to be replaced (not the whole phrase but one name which might consist of few words). Second sheet2 contains in 1 column values which I need to find in Sheet1 (there might be more than one time when value appears to be found in 1st column) and column which contains translation. I don't need Google API for this because names are very custom.

Code:

---


Dim sht As WorksheetI came across to the following script but it says: run-time error '9'. Subscript out of range. Please advise.



---

Code:

---

Dim fndList As Integer
Dim rplcList As Integer
Dim tbl As ListObject
Dim myArray As Variant


'Create variable to point to your table
  Set tbl = Worksheets("Sheet1").ListObjects("Table1")


'Create an Array out of the Table's Data
  Set TempArray = tbl.DataBodyRange
  myArray = Application.Transpose(TempArray)
 
'Designate Columns for Find/Replace data
  fndList = 1
  rplcList = 2


'Loop through each item in Array lists
  For x = LBound(myArray, 1) To UBound(myArray, 2)
    'Loop through each worksheet in ActiveWorkbook (skip sheet with table in it)
      For Each sht In ActiveWorkbook.Worksheets
        If sht.Name <> tbl.Parent.Name Then
         
          sht.Cells.Replace What:=myArray(fndList, x), Replacement:=myArray(rplcList, x), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False
       
        End If
      Next sht
  Next x


End Sub

---

Simplified code

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

---

Well, now it says run-time error '5. Invalid procedure call or argument.

My test file

Thanks a lot. It works with sample but looks like if there are no matches then script gives an error. I've added 'On error resume next' and I see that script works but it crashes Excel. So either I need to modify script or set timeout, am I right?

See attached.

A change to the loop exit is required

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)
        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

---

Finally, it works. Thanks a lot for your help! Just to follow up this a little bit. Seems to me that with larger number of values to be replaced and more word translations script is running for too long. Is it possible to use Excel function Replace like code below:

Code:

---

        Target.Cells.Replace What:=fndList(x, 1), Replacement:=fndList(x, 2), _
        LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, _
        SearchFormat:=False, ReplaceFormat:=False

---

Try

Code:

---

    Dim Sh1 As Worksheet
    Dim Sh2 As Worksheet
    Dim FndList, x&


    Set Sh1 = Sheets(1)
    Set Sh2 = Sheets(2)
    FndList = Sh2.Cells(1, 1).CurrentRegion
    For x = 1 To UBound(FndList)
        Sh1.Cells.Replace What:=FndList(x, 1), Replacement:=FndList(x, 2), LookAt:=xlPart
    Next

---

Quote:

---

Originally Posted by mdmackillop

Try

Code:

---

    Dim Sh1 As Worksheet
    Dim Sh2 As Worksheet
    Dim FndList, x&


    Set Sh1 = Sheets(1)
    Set Sh2 = Sheets(2)
    FndList = Sh2.Cells(1, 1).CurrentRegion
    For x = 1 To UBound(FndList)
        Sh1.Cells.Replace What:=FndList(x, 1), Replacement:=FndList(x, 2), LookAt:=xlPart
    Next

---

---

Thanks mdmackillop for this thread. I'm getting closer to my solution. I'm working on an excel book that has a 4500+ word list in sheet 1 column A. Sheet 2 column A has a 3500+ cell column of text strings. I want to search through sheet 2 and remove any words that are the same as in sheet 1. The biggest issue I am having is that the sheet 2 list is a string of words in each cell, not just a single word. Your above code is taking quite a while, as Dmitry has pointed out. The below code seems like it might work. However I don't know how to put the sheet, column, and row locations into your code below. I'm not new to excel but am to VBA. I've dabbled in code so am not scared to get my hands dirty. Can you help? Let me know if I've missed any vital info you need from me.

Quote:

---

Originally Posted by mdmackillop

Try

Code:

---

    Dim Sh1 As Worksheet
    Dim Sh2 As Worksheet
    Dim FndList, x&


    Set Sh1 = Sheets(1)
    Set Sh2 = Sheets(2)
    FndList = Sh2.Cells(1, 1).CurrentRegion
    For x = 1 To UBound(FndList)
        Sh1.Cells.Replace What:=FndList(x, 1), Replacement:=FndList(x, 2), LookAt:=xlPart
    Next

---

---

for i = 3 to 6 worksheets("sheet1").range("a2:a35").select
selection.replace what:=cells(i,3).value,replacement:=cells(i,4).value, lookat:xlpart,searchorder:=xlByRows,matchcase:=False
Next
Worksheets("sheet1").cells(1,1).select
end sub
What if the value to be replaced is in another column? For example, I still want the range of value to be found in column "A" but then replace the value in "column B" of the same row. How would the code change?

i have certain values in column A,if that value is present have to replace the value in column B