Written by Allen Wyatt (last updated September 14, 2019)
This tip applies to Excel 97, 2000, 2002, and 2003
Rusty has a list of ZIP Codes in a column of a worksheet. He would like a way to "compress" the codes so that sequential ranges of values are on a single row. So, for instance, instead of 35013, 35014, and 35015 taking up three rows, they would appear on a single row as 35013-35015.
There are a couple of ways to go about this—with or without macros. On the "without macros" side of the fence, there are a number of different approaches, and all of them involve the use of additional columns to hold intermediate results.
For example, let's assume that you have your data in column A, starting in cell A2, and that cell A1 is empty (it doesn't even have header text in it). In this case you could enter the following formula in cell B2:
=IF(NOT(A2-A1=1),A2,IF(A3-A2=1,B1,A2))
Then, in cell C2, enter the following long formula:
=IF(NOT(A3-A2=1),IF(A2-A1=1,TEXT(B1,"00000") &" - "&TEXT(B2,"00000"),TEXT(A2,"00000")),"")
Now you can copy the formulas in cells B2:C2 down their respective columns. What you end up with in column C is the condensed series of ZIP Codes. You can copy these values, using Paste Special to ignore blank cells, to anyplace else you want.
If you want to use a macro approach, then there are no intermediate columns necessary. A macro can be written that essentially collapses the list of ZIP Codes in place. The following macro loops through whatever range of cells you selected and creates the condensed list:
Sub CombineValues() Dim rng As Range Dim rCell As Range Dim sNewArray() As String Dim x As Long Dim y As Long Dim sStart As String Dim sEnd As String Set rng = Selection sStart = rng.Cells(1) sEnd = sStart y = 1 For x = 1 To rng.Count - 1 If rng.Cells(x + 1) - _ rng.Cells(x) > 1 Then 'End ReDim Preserve sNewArray(1 To y) If sStart = sEnd Then sNewArray(y) = sStart Else sNewArray(y) = sStart & "-" & sEnd End If sStart = rng.Cells(x + 1) y = y + 1 End If sEnd = rng.Cells(x + 1) ReDim Preserve sNewArray(1 To y) If sStart = sEnd Then sNewArray(y) = sStart Else sNewArray(y) = sStart & "-" & sEnd End If Next rng.ClearContents For x = 1 To y rng.Cells(x) = "'" & sNewArray(x) Next Set rng = Nothing Set rCell = Nothing End Sub
Note:
ExcelTips is your source for cost-effective Microsoft Excel training. This tip (3853) applies to Microsoft Excel 97, 2000, 2002, and 2003. You can find a version of this tip for the ribbon interface of Excel (Excel 2007 and later) here: Condensing Sequential Values to a Single Row.
Create Custom Apps with VBA! Discover how to extend the capabilities of Office 365 applications with VBA programming. Written in clear terms and understandable language, the book includes systematic tutorials and contains both intermediate and advanced content for experienced VB developers. Designed to be comprehensive, the book addresses not just one Office application, but the entire Office suite. Check out Mastering VBA for Microsoft Office 365 today!
If you need to generate a random sequence of characters, of a fixed length, then you'll appreciate the discussion in this ...
Discover MoreOne branch of mathematics allows you to work with what are called "simultaneous equations." Working with this type of ...
Discover MoreAt the heart of working with Excel is the process of creating formulas that calculate results based on information within ...
Discover MoreFREE SERVICE: Get tips like this every week in ExcelTips, a free productivity newsletter. Enter your address and click "Subscribe."
There are currently no comments for this tip. (Be the first to leave your comment—just use the simple form above!)
Got a version of Excel that uses the menu interface (Excel 97, Excel 2000, Excel 2002, or Excel 2003)? This site is for you! If you use a later version of Excel, visit our ExcelTips site focusing on the ribbon interface.
FREE SERVICE: Get tips like this every week in ExcelTips, a free productivity newsletter. Enter your address and click "Subscribe."
Copyright © 2025 Sharon Parq Associates, Inc.
Comments