List City Codes Automatically

[arrchurro]

I have this list of country/City Codes, that when it gets sent to me the cities are all grouped in one cell. I have to manually seperate 1 row for each city code. Is there an easier way to do this?

so, in cell A1 I have 1-3, 6-9, 10, 15, 20-25

Manually I have to put:

B1 = 1
B2 = 2
B3 = 3
B4 = 6
B5 = 7
B6 = 8

etc etc.... Is there a macro that can do this for me? Right now I use text to columns, but its the ranges that kill me.

 

[pgc01]

Hi arrchurro

I'glad it works, but I think 1 minute is too much. I've redesigned the code. There are no more insert cells.

The idea now is.

Read column A into an array
Start from clean columns A:B
This way you simply write the codes as you go along.

This should be much quicker (several times quicker).

Please test

Best regards
PGC

Option Explicit

Sub citycodes()
Dim arrCodeList(10000), lLastRow As Long, lRow As Long, l As Long
Dim vCodeRanges, vCodes, i As Integer, ii As Integer

lLastRow = Range("A1").End(xlDown).Row
For i = 1 To lLastRow
    arrCodeList(i) = Range("A1").Cells(i)
Next
Columns("A:B").ClearContents

For l = 1 To lLastRow
    Range("A" & lRow + 1).Value = arrCodeList(l)
    vCodeRanges = Split(arrCodeList(l), ",")

    For i = 0 To UBound(vCodeRanges)
        vCodes = Split(Trim(vCodeRanges(i)), "-")
        lRow = lRow + 1
        Range("B" & lRow) = vCodes(0)
        If UBound(vCodes) > 0 Then
            For ii = vCodes(0) + 1 To vCodes(1)
                lRow = lRow + 1
                Range("B" & lRow) = ii
            Next ii
        End If
    Next i
Next l

End Sub