Excel-VBA dictionary for replacing text strings

[Arturo333]

I have a table with a column of airport codes (HAM, BER, TLL, VNC etc.) and I need to create a VBA macro that would fill another column with respective country codes (HAM>DE, BER>DE, TLL>EE, VNC>IT).

[TABLE="width: 500"]
<tbody>[TR]
[TD]Column A[/TD]
[TD]Column B[/TD]
[/TR]
[TR]
[TD]HAM[/TD]
[TD]DE[/TD]
[/TR]
[TR]
[TD]BER[/TD]
[TD]DE[/TD]
[/TR]
[TR]
[TD]TLL[/TD]
[TD]EE[/TD]
[/TR]
[TR]
[TD]VNC[/TD]
[TD]IT[/TD]
[/TR]
</tbody>[/TABLE]

I have done a lot of research on the use of VBA dictionaries for this purpose. Even found a few similar cases and tried to modify the code to fit my need, but not successful so far...
I believe that dictionary is the most suitable method for this purpose because it stores all the values in macro (not in a separate sheet) and can be expanded gradually and easily. Unfortunately, my VBA knowledge and experience is not sufficient to completely understand the mechanics behind the dictionaries method.
Can someone help me to create a macro for this?

The most promising macro that I found so far is this one:

Sub Tester2()

    Dim regEx As Object, dict As Object
    Dim matches, m
    Dim c As Range
    Dim s As String, mat As String

    Set dict = CreateObject("scripting.dictionary")
    dict.Add "HAM", "DE"
    dict.Add "BER", "DE"
    dict.Add "TLL", "EE"
    dict.Add "VNC", "IT"

    Set regEx = CreateObject("vbscript.regexp")
    regEx.Pattern = "(\d{1,3}\%\s+)(\w+)"              ' - this line of the original code is not relevant I guess
    regEx.Global = True
    regEx.IgnoreCase = True
    regEx.MultiLine = True

    For Each c In ActiveSheet.Range("A1:A10")
        s = c.Value
        Set matches = regEx.Execute(s)
        If Not matches Is Nothing Then
            'loop over each of the match objects
            For Each m In matches
                mat = m.submatches(1) 
                  If dict.Exists(mat) Then
                    s = Replace(s, m, Replace(m, mat, dict(mat)))
                End If
            Next m
        End If
        c.Offset(0, 1).Value = s
    Next c

End Sub

</second>

 

[Fluff]

Hi & welcome to MrExcel.
With data like you have shown, how about

Sub Airports()
   Dim Cl As Range
   Dim Dic As Object
   
   Set Dic = CreateObject("scripting.dictionary")
   Dic.Add "HAM", "DE"
   Dic.Add "BER", "DE"
   Dic.Add "TLL", "EE"
   Dic.Add "VNC", "IT"
   
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
      Cl.Offset(, 1).Value = Dic(Cl.Value)
   Next Cl
End Sub

 

[Arturo333]

Yes - it works!!! Thank you!!!

 

[Fluff]

You're welcome