Take numbers in a list and convert to ranges for consecutive numbers

[Sachin111]

I have a problem that I'm sure there is a formula that can perform this function.

I have a list of numbers, some are consecutive and some are outliers. I need to take this data and create a "From" "To" column on those numbers that are consecutive. Below is an example of the data that I have and an example of what I need this data to look. There are about 16000 rows and 1 columns filled with data like this:

Current data
110001
110002
110003
110004
110005
110006
110007
110008
110009
110010
121000
121001
121002
121003
121004
121005
121006
121007
121008
121010
121012
121013
121015
121101
121102

To this:
110001...110010
121000...121008
121010...121102

Please help. I appreciate any help that can be provided.

Update:
I found a possible solution on another forum, but it didn't work for me. Posting it here if it may help. The result for that is in the image.

Enter below formula as an array formula in cell C2 & copy down:
=IF(MAX($C$1:D1)=MAX($A$2:$A$20),"",MIN(IF($A$2:$A$20<>"",IF($A$2:$A$20>MAX($C$1:$D1),$A$2:$A$20))))

Enter below formula as an array formula in cell D2 & copy down:
=IF(INDEX($A$2:$A$20,SMALL(IFERROR(IF(($A$3:$A$20-$A$2:$A$19=1)=FALSE,ROW($A$2:$A$20)-ROW($A$2)+1),1E+100),ROW(1:1)))-INDEX($A$2:$A$20,SMALL(IFERROR(IF(($A$3:$A$20-$A$2:$A$19=1)=FALSE,ROW($A$2:$A$20)-ROW($A$2)+1),1E+100),ROW(1:1))-1)=1,INDEX($A$2:$A$20,SMALL(IFERROR(IF(($A$3:$A$20-$A$2:$A$19=1)=FALSE,ROW($A$2:$A$20)-ROW($A$2)+1),1E+100),ROW(1:1))),"")

 

[kweaver]

How can 121010...121102 be right if the numbers in that range are NOT consecutive? There isn't a 12121011, nor is there a 121014, etc.

 

[Sachin111]

Apologies for the mixup. You are right, my bad in framing the question. For the aforementioned data, the ranges would look like:

To this:
110001...110010
121000...121008
121010
121012...121013
121015
121101...121102

 

[Rick Rothstein]

I believe the following macro will do what you want. It assumes your data is in Column A starting on Row 2 and outputs its results to Column C starting on Row 2.

Sub MakeRanges()
  Dim R As Long, Arr As Variant, Parts As Variant
  Arr = Range("A2", Cells(Rows.Count, "A").End(xlUp))
  For R = UBound(Arr) - 1 To 2 Step -1
    If Arr(R, 1) = Arr(R - 1, 1) + 1 Then
      Arr(R, 1) = ""
    Else
      Arr(R, 1) = Arr(R - 1, 1) & "X" & Arr(R, 1)
    End If
  Next
  Arr = Split(Replace(Application.Trim(Join(Application.Transpose(Arr))), " ", "..."), "X")
  For R = 0 To UBound(Arr)
    Parts = Split(Arr(R), "...")
    If Parts(0) = Parts(1) Then Arr(R) = Split(Arr(R), "...")(0)
  Next
  With Range("C2").Resize(1 + UBound(Arr))
    .NumberFormat = "@"
    .Value = Application.Transpose(Arr)
  End With
End Sub

 

[Sachin111]

Hi Rick, thanks for sending this code, really appreciate the time you took for this.

Unfortunately, it didn't work out.

I kept getting this error.

However, I did more digging to find a solution and found it at this forum, and a particular code worked for me. Sharing it just to close this thread. Thanks again1

Option Explicit
Sub Sequencer()
 
 Dim i As Long
 Dim col As Long
 Dim dRow As Long
 Dim sRow As Long
 Dim LastRow As Long
 
 ' speed
 Application.ScreenUpdating = False
 
 '***begin change***
 '
 'init start row: CHANGE TO SUIT
 sRow = 2
 'set column to work on: CHANGE TO SUIT
 col = 1
 '
 '***end change***
 
 
 'get last row of data to process
 LastRow = Cells(65536, col).End(xlUp).Row
 
 'init dest row
 dRow = sRow
 
 'do all rows
 For i = 2 To LastRow
 'xform string to number. if next cell doesn't equal this cell + 1
 If CLng(Cells(i + 1, 1)) <> CLng(Cells(i, 1)) + 1 Then
 'new sequence
 Cells(dRow, 1) = Cells(sRow, 1) & " - " & Cells(i, 1)
 'new start
 sRow = i + 1
 'new dest row
 dRow = dRow + 1
 'incr for next loop
 i = i + 1
 End If
 Next i
 
 'clear remainder of list
 Range(Cells(dRow, col), Cells(65536, col)).Clear
 
 'reset
 Application.ScreenUpdating = True
 
End Sub

 

[Rick Rothstein]

Hi Rick, thanks for sending this code, really appreciate the time you took for this.

Unfortunately, it didn't work out... I kept getting this error.

Just out of curiosity, can you tell me what line of code was highlighted when the error message appeared? Also, what version of Excel are you using?