List City Codes Automatically

arrchurro

New Member
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

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
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

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``````

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?

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?

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

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.

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

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.

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

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.

Replies
3
Views
710
Replies
2
Views
91
Replies
9
Views
164
Replies
6
Views
172
Replies
10
Views
590

1,196,181
Messages
6,013,899
Members
441,791
Latest member
SKeulder

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.

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

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