Put CSV Zip Codes into Zip Code Ranges

[84thsav]

I have a list of about ~13,000 zipcodes in csv format (15002,15003,15004,15005,15006,15007,15009,15010) that i need to put into zip ranges (15002-15007,15009-15010)

I realize i can do this manually but that takes a lot of time and i mean who wants to do that! I cant figure out a method or a formula for this one.

Id appreciate any feedback Thank you

A1	A2	A3	A4	A5
15002	15003	15004	15005	15006

Would turn into the below format

A1	A2	A3	A4	A5
15002	15003-15006	15007

 

[Joe4]

Welcome to the Board!

In your example, why aren't the values of 15002 and 15007 included in your range, to show 15002-15007, instead of 15003-15006?

 

[Rick Rothstein]

When you say the zip codes are in "csv format", do you mean you have a text file (with .csv extension) that you want to read into Excel and process as indicated? Or are all your value already in the worksheet in Column A starting at Row 1?

 

[alansidman]

crossposted: Csv zip codes to zip code range

 

[84thsav]

Welcome to the Board!

In your example, why aren't the values of 15002 and 15007 included in your range, to show 15002-15007, instead of 15003-15006?

SORRY looks like i made a mistake when i made that. Let me clarify. The missing zipcodes would need to be ignored

A1	A2	A3	A4	A5
15001	15003	15004	15005	15006

Would turn into the below format

A1	A2	A3	A4	A5
15001	15003-15006	15008

 

[Rick Rothstein]

What about the questions I asked in Message #3?

 

[84thsav]

What about the questions I asked in Message #3?

A1:LCO1 approximately 8500 values that need to be put into ranges as explained above

 

[MoshiM]

A1:LCO1 approximately 8500 values that need to be put into ranges as explained above

Will the zip codes always be in order from smallest to largest?

 

[MoshiM]

Try the following on a COPY of your data if it meets the conditions in post #8

Sub Zip_Code_Compile()

Dim ZipCodes() As Variant, Comparison_CLCTN As New Collection, _
Reassign_D1 As Boolean

Dim N As Long, D1 As Long

ZipCodes = ActiveSheet.UsedRange.Rows(1).Value2 'Only the first row will be parsed

For N = LBound(ZipCodes, 2) To UBound(ZipCodes, 2)

    If N = LBound(ZipCodes, 2) Then
    
        D1 = N                  'Will be used to record location within array of first part of zip code string
        
    ElseIf ZipCodes(1, N) <> ZipCodes(1, N - 1) + 1 Or N = UBound(ZipCodes, 2) Then 'If current array value isn't greater than the previous by 1 then

        If N <> UBound(ZipCodes, 2) And N - 1 <> D1 Then   ' ......[012]4........
        
            Comparison_CLCTN.Add ZipCodes(1, D1) & "-" & ZipCodes(1, N - 1)
            Reassign_D1 = True
            
        ElseIf N = UBound(ZipCodes, 2) And ZipCodes(1, N) = ZipCodes(1, N - 1) + 1 Then '........[01234]
        
            Comparison_CLCTN.Add ZipCodes(1, D1) & "-" & ZipCodes(1, N)
        
        ElseIf N - 1 = D1 Then                   '[0]4
        
            Comparison_CLCTN.Add ZipCodes(1, D1)
            
            If N = UBound(ZipCodes, 2) Then     '[0][2]
                Comparison_CLCTN.Add ZipCodes(1, N)
            Else
                Reassign_D1 = True
            End If
            
        ElseIf N = UBound(ZipCodes, 2) Then     '[0]
        
            Comparison_CLCTN.Add ZipCodes(1, N)
            
        End If
  
        If Reassign_D1 = True Then
            D1 = N               'Reassign new values
            Reassign_D1 = False
        End If
        
    End If
    
Next N

ReDim ZipCodes(1 To Comparison_CLCTN.Count)

For N = 1 To Comparison_CLCTN.Count
    ZipCodes(N) = Comparison_CLCTN(N)
Next N

With ActiveSheet.UsedRange.Rows(1)
    .ClearContents
    .Resize(1, UBound(ZipCodes)).Value2 = ZipCodes
End With

End Sub

 

[Rick Rothstein]

Here is another macro that you can try (note that output is placed on Sheet2)...

Sub ZipCodeSequences()
  Dim X As Long, Zips As String, V As Variant, Arr As Variant, Result As Variant
  Zips = Space(500000)
  Arr = Range("A1", Cells(1, Columns.Count).End(xlToLeft))
  For X = 1 To UBound(Arr, 2)
    Mid(Zips, 5 * (Arr(1, X) - 1), 5) = Format$(Arr(1, X), "00000")
  Next
  For Each V In Array(232, 22, 6, 4, 2, 2)
    Zips = Replace(Zips, Space(V), " ")
  Next
  Arr = Split(Trim(Zips))
  ReDim Result(1 To 1, 1 To 1 + UBound(Arr))
  For X = 0 To UBound(Arr)
    If Len(Arr(X)) = 5 Then
      Result(1, X + 1) = Arr(X)
    Else
      Result(1, X + 1) = Left(Arr(X), 5) & "-" & Right(Arr(X), 5)
    End If
  Next
  With Sheets("Sheet2").Range("A1").Resize(, UBound(Result, 2))
    .Value = Result
    .Columns.AutoFit
  End With
End Sub