Hi, I have the below code in the attached file. What I am trying to do is find and replace multiple values contained in one cell. Looking at the file, I want the company names in column A replaced with the values in column D which represent a list of the company names in column C. See cell B25 for example. I have this code written but it only replaces the first value found and deletes the rest. I would appreciate any help. Thanks in advance.
Sub String_Replacer()
Dim ws As Worksheet, wb As Workbook
Dim fList As Variant, I As Integer
Dim rng1 As Range
Dim rng2 As Range
Dim cel As Range
Dim strMyChar As String, strMyReplace As String
Application.ScreenUpdating = False
With ActiveWorkbook.Worksheets("Sheet1")
Set rng1 = .[C1:C2405]
End With
With ActiveWorkbook.Worksheets("Sheet1")
Set rng2 = .[A1:A5115]
End With
For Each cel In rng1.Cells
strMyChar = cel.Value
strMyReplace = cel.Offset(0, 1).Value
With rng2
.Replace What:=strMyChar, Replacement:=strMyReplace, _
SearchOrder:=xlByColumns, MatchCase:=True
End With
Next cel
Application.ScreenUpdating = True
End Sub
Bookmarks