# Zip Code Range Extraction

#### 23hawk

##### New Member
I have been trying to figure out how to extract zipcode range from a single cell. My data contains a single column with multiple formats. One cell could have a single zipcode like 30040. But, another could have a range like 30040-99. Sample data below. Would like to have just individual zipcodes in a single column.</SPAN>
 30002-05 30009 - 10 30021 30022-23 30029-32

<TBODY>
</TBODY>

The output I am trying to get is below

30002
30003
30004
30005
30009
30010
30021
30022
30023
30029
30030
30031
30032 </SPAN>
Any help on this is greatly appreciated - We Love MREXCEL !!​

### Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.

=left(a1,5)

#### 23hawk

##### New Member
Not quite what I am needing. I need the list to extract the numbers in the ranges then also list the number that are individually listed.

#### Scott Huish

##### MrExcel MVP
Assuming data in Column A, and output in Column B. Change as necessary.

Code:
``````Sub test()
Dim m, c As Range, s As String, x As Long
Range("B:B").ClearContents
With CreateObject("Scripting.Dictionary")
For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
s = Left(c, 5)
If Not .exists(s) Then .Add s, s
Next
For Each m In .items
x = x + 1
Range("B" & x) = m
Next
End With
End Sub``````

#### 23hawk

##### New Member

That is close however I am looking for a way to list the numbers from each cell to a single cell - such as 30002-30005 is in 1 cell. I need it to create (extract)a list of cells in a column from that cell to show 30002
30003
30004
30005
And then list the one number in a cell if that is all there is - like 30010 then go to the next and extract again if it is a new range like 30012-14 .

#### Scott Huish

##### MrExcel MVP
Code:
``````Sub test()
Dim x As Long, y As Long, c As Range, t
For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
t = Split(c, "-")
If UBound(t) = 0 Then
x = x + 1
Cells(x, 2) = c
Else
For y = Val(t(0)) To Val(Left(t(0), 3) & t(1))
x = x + 1
Cells(x, 2) = y
Next y
End If
Next
End Sub``````

#### Scott Huish

##### MrExcel MVP

I got a message from you saying it didn't stop. What range is your data actually in? Can you provide an actual sample of your data? Are there formulas in the column with your zip code ranges and formulas in cells that appear blank?

These were my results based on the samples you posted:

Excel Workbook
AB
130002-0530002
230009 - 1030003
33002130004
430022-2330005
530029-3230009
630010
730021
830022
930023
1030029
1130030
1230031
1330032
Sheet1

Last edited:

#### Scott Huish

##### MrExcel MVP
Code:
``````Sub test()
Dim x As Long, y As Long, c As Range, t
For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
t = Split(c, "-")
If UBound(t) = 0 Then
x = x + 1
Cells(x, 2) = c
Else
For y = Val(t(0)) To Val(t(1))
x = x + 1
Cells(x, 2) = y
Next y
End If
Next
End Sub``````

#### 23hawk

##### New Member
Works Perfect - you are the greatest ! Thank-you !

Replies
10
Views
182
Replies
15
Views
607
Replies
2
Views
915
Replies
1
Views
452
Replies
0
Views
211