Find and replace whole cell by substring

CaptainCsaba

Board Regular
Joined
Dec 8, 2017
Messages
78
Hi!

I have a file in which there are a lot of company names in column A. They are not perfect so a lot of them have to be corrected by find and replace. I created another workbook called "namechanges.xlsx". In this file column A contains the substrings that have to be matched in the other files strings, and column B contains the replacement text. I have managed to find a code that almost works, however I think it uses the whole cells as comparison and is nto trying to match the substrings in the cells and thus there is no match. How can we fix this?

Code:
Sub FindAndReplaceing()    Dim NameListWB As Workbook, thisWb As Workbook
    Dim NameListWS As Worksheet, thisWs As Worksheet
    Dim i As Long, lRow As Long


    '~~> This is the workbook from where your code is running
    Set thisWb = ThisWorkbook
    '~~> Change this to the sheet name where you want to replace
    '~~> in Column A
    Set thisWs = thisWb.Sheets("Sheet1")


    '~~> File.xlsx
    Set NameListWB = Workbooks.Open("C:\Users\xyz\namechanges.xlsx")
    Set NameListWS = NameListWB.Worksheets("Sheet1")


    With NameListWS
        '~~> Find last row in Col A of File.xlsx
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row


        '~~> Loop though Col A
        For i = 1 To lRow
            '~~> Do the replace
            thisWs.Columns(1).replace What:=.Range("A" & i).Value, _
                                      Replacement:=.Range("B" & i).Value, _
                                      SearchOrder:=xlByColumns, _
                                      MatchCase:=False
        Next i
    End With
End Sub
 
You can upload them to a share site such as OneDrive, Google Drive, Dropbox. Mark for sharing & post the link to the thread
 
Upvote 0

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Is the code located in the file with the names you want changing?
 
Upvote 0
I think not, it is saved separately but it is here in the forum post if you need it. Sorry about me forgetting to include it.
 
Upvote 0
Try this code

Code:
Sub FindAndReplaceing()
    Dim NameListWB As Workbook, thisWb As Workbook
    Dim NameListWS As Worksheet, thisWs As Worksheet
    Dim i As Long, lRow As Long
    Dim Frng As Range


    '~~> This is the workbook from where your code is running
    Set thisWb = ThisWorkbook
    '~~> Change this to the sheet name where you want to replace
    '~~> in Column A
    Set thisWs = thisWb.Sheets("Sheet1")




    '~~> File.xlsx
    Set NameListWB = Workbooks.Open("C:\Users\xyz\namechanges.xlsx")
    Set NameListWS = NameListWB.Worksheets("Sheet1")




    With NameListWS
        '~~> Find last row in Col A of File.xlsx
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row




        '~~> Loop though Col A
        For i = 1 To lRow
            '~~> Do the replace
            Set Frng = .Columns(1).Find(thisWs.Range("A" & i).Value)
            
            If Not Frng Is Nothing Then
            thisWs.Columns(1).Range("A" & i).Value = Frng.Offset(0, 1).Value
            End If
        Next i
    End With
End Sub
 
Last edited:
Upvote 0
If the code is not in the same workbook as the values to be changed, then change this line
Code:
Set thisWb = ThisWorkbook
to
Code:
Set thisWb = ActiveWorkbook
 
Upvote 0
It was this! It finally works! Thank you so much Fluff, this will save so much work! I'll post the final code here for anybody who find this later:

Code:
Sub Sample()    Dim NameListWB As Workbook, thisWb As Workbook
    Dim NameListWS As Worksheet, thisWs As Worksheet
    Dim i As Long, lRow As Long


    '~~> This is the workbook from where your code is running
    Set thisWb = ActiveWorkbook
    '~~> Change this to the sheet name where you want to replace
    '~~> in Column A
    Set thisWs = thisWb.Sheets("Sheet1")


    '~~> File.xlsx
    Set NameListWB = Workbooks.Open("C:\Users\csaba.hari\Desktop\webscrape\namechanges.xlsx")
    Set NameListWS = NameListWB.Worksheets("Sheet1")


    With NameListWS
        '~~> Find last row in Col A of File.xlsx
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row


        '~~> Loop though Col A
        For i = 1 To lRow
            '~~> Do the replace
            thisWs.Columns(1).replace .Range("A" & i).Value, .Range("B" & i).Value, xlPart, , False, , False, False
        Next i
    End With
End Sub
 
Upvote 0
You're welcome & thanks for the feedback
 
Upvote 0
One thing, judging by the strings you showed in post#5 I would expect you to end up with
BREWIN DOLPHIN HOLDINGS PLC PLC
 
Upvote 0
Try the 2nd option from post#9
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,208
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top