Create ranges out of rows VBA - excel

Question

I have multiple rows which are sometimes in order and sometimes not.
Out of rows which are in order, I would need to create a range, which are not in order just to copy the number.
The thing is, the most rows in order can be even 20.
For example cells:
1
3
5
6
7
8
9
10
13
14
15
There would be:
1
3
5-10
13-15
Is it possible to code it?
Thanks

Answer 1

Assuming your data starts with A1.... and
required results will be printed at C column.
Try with below code
Sub test()
Dim i As Long, lastrow As Long, incre As Long
Dim startno As Variant
Dim endno As Variant
incre = 1
lastrow = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lastrow
If Cells(i, 1) = (Cells(i + 1, 1) - 1) Then
startno = Cells(i, 1)
Do While Cells(i, 1) = (Cells(i + 1, 1) - 1)
endno = Cells(i + 1, 1)
i = i + 1
Loop
Cells(incre, 3) = "'" & startno & "-" & endno
incre = incre + 1
Else
Cells(incre, 3) = Cells(i, 1)
incre = incre + 1
End If
Next i
End Sub

Answer 2

if you want the address of all consecutive ranges you could use:
Option Explicit
Sub main()
Dim rangeStrng As String
With Worksheets("MyRowsSheet") '<--| change "MyRowsSheet" with your actual sheet name
rangeStrng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstants).Areas.Parent.Address(False, False)
End With
End Sub
if you want only the rows range then you could use:
Option Explicit
Sub main2()
Dim rng As Range
Dim rowsRangeStrng As String
With Worksheets("MyRowsSheet") '<--| change "MyRowsSheet" with your actual sheet name
For Each rng In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
If rng.Rows.Count = 1 Then
rowsRangeStrng = rowsRangeStrng & rng.Rows(1).Row & ","
Else
rowsRangeStrng = rowsRangeStrng & rng.Rows(1).Row & "-" & rng.Rows(rng.Rows.Count).Row & ","
End If
Next rng
End With
If rowsRangeStrng <> "" Then rowsRangeStrng = Left(rowsRangeStrng, Len(rowsRangeStrng) - 1)
End Sub

Answer 3

If I understood your question correctly, you are not looking to address a range, but rather want an output table. This code below should provide you with just that. My input numbers are in column A, and the output is in column B.
Sub sequentials()
Dim tws As Worksheet
Dim tmpRowA, tmpRowB As Integer
Dim seq() As Long
Dim frA, frB, lrA As Integer 'firstrow col A, col B, lastrow of data
Set tws = ThisWorkbook.Worksheets("Sheet1")
frA = 2
frB = 2
lrA = tws.Range("A1000000").End(xlUp).Row
'Input in column A, Output in column B
'Headers in Row 1
ReDim seq(0 To lrA - 1)
seq(0) = -2
seq(1) = tws.Range("A" & frA).Value
tmpRowA = frA
tmpRowB = frB
tws.Range("B" & frB & ":B" & lrA).NumberFormat = "#"
For r = frA + 1 To lrA
If r = 23 Then
r = 23
End If
With tws
seq(r - 1) = .Range("A" & r).Value
If seq(r - 1) = seq(r - 2) + 1 Then
If r = lrA Then
.Range("B" & tmpRowB).Value = .Range("A" & tmpRowA - 1).Value & "-" & seq(r - 1)
End If
Else
If seq(r - 2) = seq(r - 3) + 1 Then
.Range("B" & tmpRowB).Value = .Range("A" & tmpRowA - 1).Value & "-" & seq(r - 2)
Else
.Range("B" & tmpRowB).Value = seq(r - 2)
End If
tmpRowB = tmpRowB + 1
tmpRowA = r + 1
If r = lrA Then
.Range("B" & tmpRowB).Value = seq(r - 1)
End If
End If
End With
Next r
End Sub
Proof of concept: