Excel-VBA dictionary for replacing text strings

Arturo333

New Member
Joined
Aug 15, 2018
Messages
4
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).

Column AColumn B
HAMDE
BERDE
TLLEE
VNCIT

<tbody>
</tbody>

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:

Code:
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>
 
Last edited by a moderator:

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,246
Office Version
  1. 365
Platform
  1. Windows
Hi & welcome to MrExcel.
With data like you have shown, how about
Code:
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
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,246
Office Version
  1. 365
Platform
  1. Windows
You're welcome
 

Watch MrExcel Video

Forum statistics

Threads
1,132,939
Messages
5,656,041
Members
418,265
Latest member
ferdinandvs

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
Top