List City Codes Automatically

arrchurro

New Member
Joined
Sep 2, 2005
Messages
15
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.
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
This macro should work for you. It assumes the original data is in cell A1:

Sub Macro1()
'Created on 9/11/06 by 4XL Solutions

'Record the string to be parsed
s = Range("A1")

'Break the string apart, and put terms in column B
Range("B1").Activate

While s <> ""
c = InStr(1, s, ",")
If c > 0 Then
temp = Left(s, c - 1)
Else: temp = s
End If

d = InStr(1, temp, "-")
If d > 0 Then
a1 = Val(Left(temp, d - 1))
a2 = Val(Right(temp, Len(temp) - d))
For i = a1 To a2
ActiveCell = i
ActiveCell.Offset(1, 0).Activate
Next i
Else
ActiveCell = temp
ActiveCell.Offset(1, 0).Activate
End If

If c > 0 Then
s = Right(s, Len(s) - c)
Else
s = ""
End If

Wend

End Sub
 
Upvote 0
Hi arrchurro

Here's another vba solution. Input in A1, output in B.

Hope this helps
PGC
Code:
Sub CityCodes()
Dim sCodes As String, vCodeRanges, vCodes
Dim i As Integer, ii As Integer, lRow As Long

sCodes = Range("A1")
vCodeRanges = Split(sCodes, ",")

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

End Sub
 
Upvote 0
thanks for the help

Thanks for the help, both solutions work well. But of course if I only had to break out the numbers in A1 it would be to easy right? how do I change the code so that it will do the same thing for all values in column A?

My list is about 1100 lines, and after I break them out row by row it will be about 10k lines.

Ideally I would like to have it as clean as possible.

A1= 1-3 the code would first insert 2 rows, then list B1=1, B2=2, B3=3
Then A4 (previousA2) = 5-7, B4=5, B5=6, B7=7

any ideas?
 
Upvote 0
thanks for the help

Thanks for the help, both solutions work well. But of course if I only had to break out the numbers in A1 it would be to easy right? how do I change the code so that it will do the same thing for all values in column A?

My list is about 1100 lines, and after I break them out row by row it will be about 10k lines.

Ideally I would like to have it as clean as possible.

A1= 1-3 the code would first insert 2 rows, then list B1=1, B2=2, B3=3
Then A4 (previousA2) = 5-7, B4=5, B5=6, B7=7

any ideas?
 
Upvote 0
Since you would like to have the solution as "clean" as possible, I'd go with pgc01's approach. I hadn't used "Split" before, but I like it, and will definitely use it in the future!

Taking liberties with pgc01's code, here are some modifications to allow you to have rows inserted for each of the entries in column B (changes in red):

Sub CityCodes()
Dim sCodes As Range, vCodeRanges, vCodes
Dim i As Integer, ii As Integer, lRow As Long

For lp = 1 To Application.WorksheetFunction.CountA(Range("A:A"))
Set sCodes = Cells(lRow + 1, 1)
vCodeRanges = Split(sCodes.Value, ",")

For j = 0 To UBound(vCodeRanges)
vCodes = Split(Trim(vCodeRanges(j)), "-")
inc = vCodes(UBound(vCodes)) - vCodes(0) + 1
c = c + inc
Next j

Range(sCodes.Offset(1, 0), sCodes.Offset(c - 1, 0)).EntireRow.Insert xlShiftDown

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

Next lp
End Sub
 
Upvote 0
Hi again, arrchurro

But of course if I only had to break out the numbers in A1 it would be to easy right?

It would be better if next time you would state the complete problem since the start. In this case to extend the previous solution to the new one is just a little adjustment in the code. However, there are cases where the approach to the problem may be different and the result of the work you developed for the first solution is lost.


New solution: Since you already have mtb'r solution this is another suggestion.

I adapted to code to accept a contiguous range of Country/City Codes, from A1, down.

I used as test in A1:A4

1-3, 10, 20-25
4
6-9,28
23,37-43

You can see the result in the image.

Does this solve your problem?
PGC

P.S. mtb'r, I'm glad you used my code, there's always room for improvment.

Code:
Option Explicit

Sub CityCodes()
Dim sCodes As String, vCodeRanges, vCodes, iInsRows As Integer
Dim i As Integer, ii As Integer, iOffset As Integer, lRow As Long, l As Long

lRow = Range("A1").End(xlDown).Row
For l = lRow To 1 Step -1
    vCodeRanges = Split(Range("A" & l).Text, ",")

    iOffset = 0
    For i = 0 To UBound(vCodeRanges)
        vCodes = Split(Trim(vCodeRanges(i)), "-")
        If iOffset<> 0 Or UBound(vCodes) > 0 Then
            iInsRows = IIf(iOffset = 0, 0, 1)
            If UBound(vCodes)<> 0 Then
                iInsRows = iInsRows + vCodes(1) - vCodes(0)
            End If
            Range("A" & l + iOffset + IIf(iOffset = 0, 1, 0)) _
                .Resize(iInsRows, 2).Insert Shift:=xlShiftDown
        End If
        For ii = 0 To vCodes(UBound(vCodes)) - vCodes(0)
            Range("B" & l + ii + iOffset) = vCodes(0) + ii
        Next ii
        iOffset = iOffset + ii
    Next i
Next l
End Sub
Book1
ABCD
11-3,10,20-251
22
33
410
520
621
722
823
924
1025
1144
126-9,286
137
148
159
1628
1723,37-4323
1837
1938
2039
2140
2241
2342
2443
25
Sheet7
 
Upvote 0
PGC

Nice code.:)

Have you considered using Autofill to insert the values instead of a loop?

I'm not sure but that might speed things up especially since the OP says there are 1000s of rows, and it might help when the ranges covered are bigger than those in the sample. eg 1000-2000

I'm sure I wrote code for practically the same problem and used Autofill.

I'll see if I can dig it out.
 
Upvote 0
Hi Norie

Thank you for your kind words. You are right about the autofill. It just didn't occurr to me that there could be big ranges. If this solution solves arrchurro's problem and he has big ranges I'll try include the autofill in a new version.

Cheers
PGC
 
Upvote 0
you guys are great

thanks a lot. the code works great, it takes a minute to run, because of all the data. but its not too slow where i cant work.

Sorry i didn't explain it completely the first time I tend to run on and I didn't want to confuse what I was trying to accomplish.

This message board is great. I know guys who have been doing things manually for years until i came along and found this site.

I really appreciate the help.
 
Upvote 0

Forum statistics

Threads
1,223,491
Messages
6,172,585
Members
452,468
Latest member
godlennutrition

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
Back
Top