Find / Replace to exclude if string is part of longer word

Replace Using Lists

• Caution: This code replaces the whole range in each worksheet with values. If there are formulas, they will be ‘lost’.
• I could not figure out why you would need ” -” so I removed them. Add them if you need them.

The Flow (not all steps and some inaccuracies)

• Writes the values from the arrays to the Dictionary.
• Loops through each worksheet.
• Writes the values from its used range (Data Range) to Data Array.
• Loops through each element in the Data Array.
• Checks the element if not error or empty value.
• Splits it by the space character into Current Values Array.
• Checks each element in Current Values Array against the Keys of the Dictionary and replaces it with the Dictionary’s Value if found.
• Joins back the elements in Current Values Array. And writes possibly modified value back to current element in Data Array.
• Writes possibly modified values from Data Array back to Data Range.

The Code

Option Explicit

Sub Adjust_Airport_Codes2()

    ' Define Find and Replace Arrays.

    ' Define Find Array.
    Dim fndList As Variant
    fndList = Array("BUE", "CHI", "DCA", "HOU", "LGA", "NYC", "WAS", "AEJ", _
                    "BUS", "CGH", "CPS", "DGM", "EHA", "EHB", "EHF", "FOQ", _
                    "FQC", "JBN", "LCY", "LGW", "LIN", "LON", "MIL", "MOW", _
                    "NAY", "ORY", "OSA", "PAR", "PUS", "QPG", "RIO", "SAO", _
                    "SAW", "SDU", "SDV", "SEL", "PVG", "TSF", "TYO", "UAQ", _
                    "VIT", "YMX", "YTO", "ZIS", "CNF", "HND", "IZM", "JKT", _
                    "LTN", "MMA", "UXM", "VCE", "VSS")
    ' Define Replace Array.
    Dim rplcList As Variant
    rplcList = Array("EZE", "ORD", "IAD", "IAH", "JFK", "JFK", "IAD", "AMS", _
                     "ICN", "GRU", "VCP", "HKG", "AMS", "BRU", "HHN", "HKG", _
                     "FRA", "PRG", "LHR", "LHR", "MXP", "LHR", "MXP", "SVO", _
                     "PEK", "CDG", "KIX", "CDG", "ICN", "SIN", "GIG", "GRU", _
                     "IST", "GIG", "TLV", "ICN", "SHA", "MXP", "NRT", "EZE", _
                     "BIO", "YUL", "YYZ", "HKG", "BHZ", "NRT", "ADB", "CGK", _
                     "LHR", "MMX", "FRA", "MXP", "MHG")
    
    ' Write values from Find and Replace Arrays to the Dictionary.
    
    Dim dict As Object         ' The Dictionary
    Set dict = CreateObject("Scripting.Dictionary")
    Dim n As Long              ' Find and Replace Arrays Element Counter
    For n = LBound(fndList) To UBound(fndList)
        dict(fndList(n)) = rplcList(n)
    Next n
    
    ' Find and replace values in each worksheet of the ActiveWorkbook.
    
    ' Declare variables to be used in loop.
    Dim sht As Worksheet       ' Current Worksheet
    Dim rng As Range           ' Current Data Range
    Dim Data As Variant        ' Current Data Array
    Dim CurVal As Variant      ' Current Value:
                               ' The value of the current element of Data Array
    Dim CurValues As Variant   ' Current Values Array:
                               ' The 'words' contained in current element
                               ' of Data Array
    Dim i As Long              ' Data Array Rows Counter
    Dim j As Long              ' Data Array Columns Counter
    Dim DataChanged As Boolean ' Data Changed Switch
    
    ' Iterate worksheets in ActiveWorkbook.
    For Each sht In ActiveWorkbook.Worksheets
        ' Define Data Range (there are other ways).
        Set rng = sht.UsedRange
        ' Write values from Data Range to Data Array.
        If rng.Rows.Count > 1 Or rng.Columns.Count > 1 Then
            Data = rng.Value
        Else
            ReDim Data(1 To 1, 1 To 1)
            Data(1, 1) = rng.Value
        End If
        ' Iterate rows in Data Array.
        For i = 1 To UBound(Data, 1)
            ' Iterate columns in Data Array.
            For j = 1 To UBound(Data, 2)
                ' Write value of current element to Current Value.
                CurVal = Data(i, j)
                ' Check if Current Value is not an error or empty value.
                If Not IsError(CurVal) And Not IsEmpty(CurVal) Then
                    ' Split Current Value by the space character into
                    ' Current Values Array.
                    CurValues = Split(CurVal)
                    ' Iterate elements of Current Values Array.
                    For n = LBound(CurValues) To UBound(CurValues)
                        ' Check if they exist as a Key in the Dictionary.
                        If dict.Exists(CurValues(n)) Then
                            ' Write value of Dictionary to current element
                            ' in Current Values Array.
                            CurValues(n) = dict(CurValues(n))
                            DataChanged = True
                            ' You can increase performance if you're expecting
                            ' only one possibly found value per cell:
                            'Exit For
                        End If
                    Next n
                    ' Write elements of Current Values Array, joined with
                    ' the space character, to current element in Data Array.
                    If DataChanged Then
                        Data(i, j) = Join(CurValues)
                        DataChanged = False
                    End If
                End If
            Next j
        Next i
        ' Write values from Data Array to Data Range.
        rng.Value = Data
    Next sht
    
End Sub