# Convert List Of Sequential Numbers Into Ranges

#### nmganey

##### New Member
hey i have a list in the same cell separated by ,
ex:
 1,2,3,4,5,9,22,23,24,25,244,245,246,247,248,249

<colgroup><col width="229"></colgroup><tbody>
</tbody>
and so on i want it to be converted into 1-5,9,22-25,244-249 any help would be much appreciated.Thanks

#### mikerickson

##### MrExcel MVP
if the string is 1,2,5,7 do you want 1-2,5,7 or 1,2,5,7?

#### mikerickson

##### MrExcel MVP
I think this UDF will do what you want
Code:
``````Function IntoRanges(aString As String, Optional Delimiter As String = ",") As String
Dim NextBit As String
Dim i As Long
Dim Items As Variant
Items = Split(aString, Delimiter)

IntoRanges = Items(0)
For i = 0 To UBound(Items) - 1
If Val(Items(i)) + 1 = Val(Items(i + 1)) Then
NextBit = "-" & Val(Items(i + 1))
Else
If NextBit = vbNullString Then
IntoRanges = IntoRanges & Delimiter & Val(Items(i + 1))

Else
IntoRanges = IntoRanges & NextBit & Delimiter & Val(Items(i + 1))
NextBit = vbNullString
End If
End If
Next i
IntoRanges = IntoRanges & NextBit
End Function``````

#### Macropod

##### Retired Moderator
The following function converts multiple sequences of 3 or more consecutive numbers in a list to a string consisting of the first & last numbers joined by a hyphen. The function includes some optional code to replace the final comma with, say, '&' or 'and'.
Code:
``````Function ParseNumSeq(StrNums As String, Optional StrEnd As String)
'This function converts multiple sequences of 3 or more consecutive numbers in a
' list to a string consisting of the first & last numbers separated by a hyphen.
' The separator for the last sequence can be set via the StrEnd variable.
Dim ArrTmp(), i As Integer, j As Integer, k As Integer
ReDim ArrTmp(UBound(Split(StrNums, ",")))
For i = 0 To UBound(Split(StrNums, ","))
ArrTmp(i) = Split(StrNums, ",")(i)
Next
For i = 0 To UBound(ArrTmp) - 1
If IsNumeric(ArrTmp(i)) Then
k = 2
For j = i + 2 To UBound(ArrTmp)
If CInt(ArrTmp(i) + k) <> CInt(ArrTmp(j)) Then Exit For
ArrTmp(j - 1) = ""
k = k + 1
Next
i = j - 2
End If
Next
StrNums = Join(ArrTmp, ",")
StrNums = Replace(Replace(Replace(StrNums, ",,", " "), ", ", " "), " ,", " ")
While InStr(StrNums, "  ")
StrNums = Replace(StrNums, "  ", " ")
Wend
StrNums = Replace(Replace(StrNums, " ", "-"), ",", ", ")
If StrEnd <> "" Then
i = InStrRev(StrNums, ",")
If i > 0 Then
StrNums = Left(StrNums, i - 1) & Replace(StrNums, ",", " " & Trim(StrEnd), i)
End If
End If
ParseNumSeq = StrNums
End Function``````
The following macro demonstrates the function.
Code:
``````Sub Test()
Dim StrNums As String
StrNums = "1,2,3,4,5,7,8,9,11,13,14,15,16"
MsgBox ParseNumSeq(StrNums, "&")
End Sub``````
To parse a given cell, you could use code like:
Code:
``````Sub Demo()
With Selection
.Value = ParseNumSeq(.Value, "&")
End With
End Sub``````

#### nmganey

##### New Member
I think this UDF will do what you want
Code:
``````Function IntoRanges(aString As String, Optional Delimiter As String = ",") As String
Dim NextBit As String
Dim i As Long
Dim Items As Variant
Items = Split(aString, Delimiter)

IntoRanges = Items(0)
For i = 0 To UBound(Items) - 1
If Val(Items(i)) + 1 = Val(Items(i + 1)) Then
NextBit = "-" & Val(Items(i + 1))
Else
If NextBit = vbNullString Then
IntoRanges = IntoRanges & Delimiter & Val(Items(i + 1))

Else
IntoRanges = IntoRanges & NextBit & Delimiter & Val(Items(i + 1))
NextBit = vbNullString
End If
End If
Next i
IntoRanges = IntoRanges & NextBit
End Function``````
Thank you soooo very much!!!! worked great!!!

#### mattsalmon

##### New Member
Hi mikerickson

Would you know of a way to do this with text as well?

I often have a list of letters, say A, B, C, D, G, K, L, M, N, P and I would like to be able to find a functions that could convert that to A - D, G, K - N, P.

Thanks,

Matt.

I think this UDF will do what you want
Code:
``````Function IntoRanges(aString As String, Optional Delimiter As String = ",") As String
Dim NextBit As String
Dim i As Long
Dim Items As Variant
Items = Split(aString, Delimiter)

IntoRanges = Items(0)
For i = 0 To UBound(Items) - 1
If Val(Items(i)) + 1 = Val(Items(i + 1)) Then
NextBit = "-" & Val(Items(i + 1))
Else
If NextBit = vbNullString Then
IntoRanges = IntoRanges & Delimiter & Val(Items(i + 1))

Else
IntoRanges = IntoRanges & NextBit & Delimiter & Val(Items(i + 1))
NextBit = vbNullString
End If
End If
Next i
IntoRanges = IntoRanges & NextBit
End Function``````

#### mikerickson

##### MrExcel MVP
Always one character? Always upper case or should the UDF be case insensitive?

#### mattsalmon

##### New Member
It will always be one character. It would be preferable if the UDF was case insensitive, although it is not critical.

#### mikerickson

##### MrExcel MVP
try changing these lines
Code:
``````If Asc(Items(i)) + 1 = Asc(Items(i + 1)) Then
NextBit = "-" & Items(i + 1)
IntoRanges = IntoRanges & Delimiter & Items(i + 1)
IntoRanges = IntoRanges & NextBit & Delimiter & Items(i + 1)``````