Zip Code Range Extraction

[23hawk]

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

[TABLE="width: 100"]
<TBODY>[TR]
[TD]30002-05</SPAN>
[/TD]
[/TR]
[TR]
[TD]30009 - 10</SPAN>
[/TD]
[/TR]
[TR]
[TD]30021</SPAN>
[/TD]
[/TR]
[TR]
[TD]30022-23</SPAN>
[/TD]
[/TR]
[TR]
[TD]30029-32</SPAN>
[/TD]
[/TR]
</TBODY>[/TABLE]

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 !!​

 

[Scott Huish]

=left(a1,5)

 

[23hawk]

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]

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

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]

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]

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]

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
	A	B
1	30002-05	30002
2	30009 - 10	30003
3	30021	30004
4	30022-23	30005
5	30029-32	30009
6		30010
7		30021
8		30022
9		30023
10		30029
11		30030
12		30031
13		30032
Sheet1

 

[Scott Huish]

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]

Works Perfect - you are the greatest ! Thank-you !