VBA - cleaning up a table of street addresses

[Krekling]

Hello.

I've got this problem at work. I'm fairly certain that it is solvable by using VBA, and I have indeed started learning VBA. However, I realise that there's a long way before I can solve this particular problem by myself, so I hope some of you guys can help.

I've got a table of nearly 20.000 street addresses that i want to put on a map. As long as the adresses that I've got in my table follow the official spelling for that address, I know exactly how to georeference it.
The trouble is that many of the "addresses" in my list is not a single address, but a collective term for several addresses, so i need to clean this up.
The norwegian street address system is as follows: Street name - house number - (house letter) , for example "Storgata 41 a" or "Lilleveien 7".

This is what I've got:

Storgata 2	OK
Storgata 3 b	OK
Lilleveien 4 f	OK
Storgata 5-9	Should be three different rows - Storgata 5, Storgata 7, Storgata 9 (every other number, as odd numbers are on one side of the street, while even numbers are on the other side)
Lilleveien 6 a-f	Should be six different rows - Lilleveien 6 a, Lilleveien 6 b, Lilleveien 6 c

What I want is a macro that recognises a hyphen , and inserts rows that contain the street name and house number for every other number in the case of "Storgata 5-9". In the case of "Lilleveien 6 a-f" it should insert rows containing the street name, house number and house letter for all of the six letters a, b, c, d, e, f.

This is what I want:

Storgata 2

Storgata 3 b

Lilleveien 4 f

Storgata 5

Storgata 7

Storgata 9

Lilleveien 6 a

Lilleveien 6 b

Lilleveien 6 c

Lilleveien 6 d

Lilleveien 6 e

Lilleveien 6 f

I would appreciate any help on this.
Thanks in advance!

 

[BSALV]

perhaps to soon to introduce a dictionary ??
Your data is in a table named "TBL_Addresses" in column A

Sub NorvegianStreets()
     Set dict = CreateObject("scripting.dictionary")            'make a dictionary

     With Range("TBL_Addresses")
          arr = .Value                                          'read the  table "TBL_Addresses" in an array
          Set sh = .Parent                                      'the sheet that table is in
     End With

     For i = 1 To UBound(arr)                                   'loop through your addresses
          If Len(arr(i, 1)) > 0 Then                            'not empty
               sp = Split(arr(i, 1))                            'split your streetname in part on the space-character (" ")
               sp2 = Split(sp(UBound(sp)), "-")                 'the last part, split that  on that character "-" (if present !)
               If UBound(sp2) <> 1 Then                         'there is not exactly 1 character "-", thus 0 or more then 1
                    dict.Add dict.Count, arr(i, 1)              'just add to the dictionary
               Else                                             'there is 1! "-" character in the last part of your address
                    If IsNumeric(sp2(0)) Then                   'is the first part of that last part numberic like 1-10
                         For j = sp2(0) To sp2(1)               'loop between min and max
                              sp(UBound(sp)) = j
                              dict.Add dict.Count, Join(sp)
                         Next

                    Else                                        'that last part of your address is not numeric, thus like "a-f"
                         If Len(sp(UBound(sp))) = 3 Then        'must have length 3 !!!
                              For j = Asc(LCase(sp2(0))) To Asc(LCase(sp2(1)))     'loop through the ASCII-codes (lcase !!! for problems like A-f)
                                   sp(UBound(sp)) = Chr(j)
                                   dict.Add dict.Count, Join(sp)
                              Next

                         Else                                   'last part not exact 3 long
                              dict.Add dict.Count, arr(i, 1)    'just add to the dictionary
                         End If

                    End If

               End If
          End If
     Next

     With sh.Columns(3)                                         'output to column C
          .ClearContents                                        'clear
          If dict.Count Then .Range("C1").Resize(dict.Count).Value = Application.Transpose(dict.items)     'write dictionary to column C
          .AutoFit                                              'adjust columnwidth
     End With

End Sub

xxxxxxxx.xlsx
	A	B	C
1	name		Storgata 2
2	Storgata 2		Storgata 3 b
3	Storgata 3 b		Lilleveien 4 f
4	Lilleveien 4 f		Storgata 5
5	Storgata 5-9		Storgata 6
6	Lilleveien 6 a-f		Storgata 7
7			Storgata 8
8			Storgata 9
9			Lilleveien 6 a
10			Lilleveien 6 b
11			Lilleveien 6 c
12			Lilleveien 6 d
13			Lilleveien 6 e
14			Lilleveien 6 f
Blad2

 

[Krekling]

perhaps to soon to introduce a dictionary ??
Your data is in a table named "TBL_Addresses" in column A

Sub NorvegianStreets()
     Set dict = CreateObject("scripting.dictionary")            'make a dictionary

     With Range("TBL_Addresses")
          arr = .Value                                          'read the  table "TBL_Addresses" in an array
          Set sh = .Parent                                      'the sheet that table is in
     End With

     For i = 1 To UBound(arr)                                   'loop through your addresses
          If Len(arr(i, 1)) > 0 Then                            'not empty
               sp = Split(arr(i, 1))                            'split your streetname in part on the space-character (" ")
               sp2 = Split(sp(UBound(sp)), "-")                 'the last part, split that  on that character "-" (if present !)
               If UBound(sp2) <> 1 Then                         'there is not exactly 1 character "-", thus 0 or more then 1
                    dict.Add dict.Count, arr(i, 1)              'just add to the dictionary
               Else                                             'there is 1! "-" character in the last part of your address
                    If IsNumeric(sp2(0)) Then                   'is the first part of that last part numberic like 1-10
                         For j = sp2(0) To sp2(1)               'loop between min and max
                              sp(UBound(sp)) = j
                              dict.Add dict.Count, Join(sp)
                         Next

                    Else                                        'that last part of your address is not numeric, thus like "a-f"
                         If Len(sp(UBound(sp))) = 3 Then        'must have length 3 !!!
                              For j = Asc(LCase(sp2(0))) To Asc(LCase(sp2(1)))     'loop through the ASCII-codes (lcase !!! for problems like A-f)
                                   sp(UBound(sp)) = Chr(j)
                                   dict.Add dict.Count, Join(sp)
                              Next

                         Else                                   'last part not exact 3 long
                              dict.Add dict.Count, arr(i, 1)    'just add to the dictionary
                         End If

                    End If

               End If
          End If
     Next

     With sh.Columns(3)                                         'output to column C
          .ClearContents                                        'clear
          If dict.Count Then .Range("C1").Resize(dict.Count).Value = Application.Transpose(dict.items)     'write dictionary to column C
          .AutoFit                                              'adjust columnwidth
     End With

End Sub

xxxxxxxx.xlsx
	A	B	C
1	name		Storgata 2
2	Storgata 2		Storgata 3 b
3	Storgata 3 b		Lilleveien 4 f
4	Lilleveien 4 f		Storgata 5
5	Storgata 5-9		Storgata 6
6	Lilleveien 6 a-f		Storgata 7
7			Storgata 8
8			Storgata 9
9			Lilleveien 6 a
10			Lilleveien 6 b
11			Lilleveien 6 c
12			Lilleveien 6 d
13			Lilleveien 6 e
14			Lilleveien 6 f
Blad2

Thank you, and sorry for taking ages to reply. This solution works perfectly! Now I'll just have to get my head around why it works, so I can modify and use it on other similar, but not identical problems.

Again, thank you!

 

[BSALV]

you're welcome