## 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
```

CLICK HERE to find out more related problems solutions.