Find and replace multiple values in Excel using VBA

[Dmitry]

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.


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



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

[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

[Dmitry]

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

[mdmackillop]

My test file

[Dmitry]

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.

[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

[Dmitry]

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:


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

[mdmackillop]

Try

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

[Dmitry]

Try

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

[Doodah]

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.


Try

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

[priyanka]

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