Abridging lists of numbers

[Guest]

Hi everyone!

I've a very long range of numbers that I desperately need to condense into
a list that contains only ranges and single numbers, e.g. 1-5,6,8,11-32,35,40

Please help me out guys - the list is ridiculously long, and will take days
to do manually!!

Thanks ;-)

 

[Bob Phillips]

Sub Test()
Dim iLastRow As Long
Dim i As Long
Dim iEnd As Long
Dim iStart As Long
Dim rng As Range

Application.ScreenUpdating = False

Rows(1).Insert
Range("A1").Value = 99 ^ 99
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
iEnd = iLastRow
For i = iLastRow To 2 Step -1
iStart = i
If Cells(i, "A").Value = Cells(i - 1, "A").Value + 1 Then
If rng Is Nothing Then
Set rng = Rows(i)
Else
Set rng = Union(rng, Rows(i))
End If
Else
If iStart < iEnd Then
Cells(i, "A").NumberFormat = "@"
Cells(i, "A").Value = Cells(iStart, "A").Value & _
"-" & Cells(iEnd, "A").Value
End If
iEnd = i - 1
End If
Next i

If Not rng Is Nothing Then rng.Delete
Rows(1).Delete

Application.ScreenUpdating = True

End Sub



--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[Ryan.Chowdhury]

Andy, assuming your range of numbers begins in cell A2 and continues
down, you'll need to create four new helper columns:

beginning in b2, copy this formula down:
=IF(A2=(A1+1),1,0)

beginning in c2, copy this formula down:
=IF(B2=1,MAX(C$1:C1),MAX(C$1:C1)+1)

beginning in d2, copy this formula down:
=COUNTIF($C$2:$C$14,"="&C2)

beginning in e2, copy this formula down:
=IF(ROW(C2)=2,A2&"-"&D2+A2-1,IF(D2=1,A2,IF(C2=C1,E1,A2&"-"&D2+A2-1)))

Now, this could probably be done in 2 or 3 columns, but it works and
it's early in the morning. You can then advance filter and copy out
the unique elements of column E to get your condensed list. Advance
Filter is in the Data > Filter Menu