Convert List Of Sequential Numbers Into Ranges

nmganey

New Member
Joined
Oct 11, 2016
Messages
18
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
Joined
Jan 15, 2007
Messages
22,884
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
Joined
Aug 27, 2007
Messages
3,321
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
Joined
Oct 11, 2016
Messages
18
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
Joined
Jun 21, 2017
Messages
5
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
Joined
Jan 15, 2007
Messages
22,884
Always one character? Always upper case or should the UDF be case insensitive?
 

mattsalmon

New Member
Joined
Jun 21, 2017
Messages
5
It will always be one character. It would be preferable if the UDF was case insensitive, although it is not critical.
 

mikerickson

MrExcel MVP
Joined
Jan 15, 2007
Messages
22,884
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)
 

Forum statistics

Threads
1,085,568
Messages
5,384,490
Members
401,904
Latest member
markschneider89

Some videos you may like

This Week's Hot Topics

Top