VBA Find and Replace Loop

[NiccoExcel]

I have a single column range with strings of text similar to this:

LIST 1

COLUMN A

LID, PLATTER PLSK CLEAR <tbody> </tbody>

SAUCE, CHILI MANGO <tbody> </tbody>

SAMPLE, SWEET STREET <tbody> </tbody>

SAUCE, ****TAIL SEAFOOD <tbody> </tbody>

<tbody>
</tbody>

My list contains about 42,000 items. I need to replace words in this list with a predefined list of acronyms/abbreviations found on another sheet. like this: LIST 2 Abbreviation/Acronym Definition ALUM Aluminium BKD Baked CHOC Chocolate CKD Cooked <tbody> </tbody> I need to create a macro that will review each item on LIST 1 and replace all words found in the "Definition" column of LIST 2 and replace the word with it's "Abbreviation/Acronym" counterpart. I want the macro to loop through each item on LIST 1 so I don't have to run it multiple times. I have tried recording a macro but I am not familiar enough with VBA to properly define the WHAT and REPLACEMENT parameters of the REPLACE method without selecting a static cell reference. Any help would be appreciated. Thanks!

<colgroup><col></colgroup><tbody>
</tbody>

 

[Joe4]

Try this code:

Sub MyReplace()

    Dim myDataSheet As Worksheet
    Dim myReplaceSheet As Worksheet
    Dim myLastRow As Long
    Dim myRow As Long
    Dim myFind As String
    Dim myReplace As String
    
'   Specify name of Data sheet
    Set myDataSheet = Sheets("Sheet1")
    
'   Specify name of Sheet with list of replacements
    Set myReplaceSheet = Sheets("Sheet2")
    
'   Assuming list of replacement start in column A on row 2, find last entry in list
    myLastRow = myReplaceSheet.Cells(Rows.Count, "A").End(xlUp).Row
    
    Application.ScreenUpdating = False
    
'   Loop through all list of replacments
    For myRow = 2 To myLastRow
'       Get find and replace values (from columns A and B)
        myFind = myReplaceSheet.Cells(myRow, "A")
        myReplace = myReplaceSheet.Cells(myRow, "B")
'       Start at top of data sheet and do replacements
        myDataSheet.Activate
        Range("A1").Select
'       Ignore errors that result from finding no matches
        On Error Resume Next
'       Do all replacements on column A of data sheet
        Columns("A:A").Replace What:=myFind, Replacement:=myReplace, LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
'       Reset error checking
        On Error GoTo 0
    Next myRow
    
    Application.ScreenUpdating = True
    
    MsgBox "Replacements complete!"
    
End Sub

You may just need to change the two sheet references at the top (where is says "Specify name of...".

My list contains about 42,000 items

Just be aware that if you have that many, you will probably have some conflicts that may cause some issues, especially if the values you are searching for may be part of larger words.

For example, let's say that you have the word "CHOCK" in your data. It will replace the beginning with "Chocolate", so you will end up with "ChocolateK".

 

[NiccoExcel]

Thanks Joe4! It worked great! Appreciate the help!

 

[Joe4]

You are welcome! Glad it worked out for you.

 

[katrinaj0210]

I am constantly working with huge files where I have to find one 3 letter country code and replace with another 3 letter country code. With in those same files I also find and replace 4 digit carrier codes. Is there a VBA code that will allow me to enter the country code and carrier codes that I dont want and replace those with the codes that I do want and changes both at the same time?

 

[Joe4]

Did you try to adapt the code I posted in this thread?

If you were not intending to try to use that code, then you should have really posted your question to a brand new thread instead of posting on to an old solved thread. That way, all users will see it as a new unanswered question (and not just the people who participated in this existing thread). Many users use the "Zero Reply Posts" listing to look for new unanswered questions. Posting onto existing threads will not show up there.