Convert List Of Sequential Numbers Into Ranges

[nmganey]

hey i have a list in the same cell separated by ,
ex:
[TABLE="width: 229"]
<colgroup><col width="229"></colgroup><tbody>[TR]
[TD="width: 229"]1,2,3,4,5,9,22,23,24,25,244,245,246,247,248,249
[/TD]
[/TR]
</tbody>[/TABLE]
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]

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

 

[nmganey]

1-2,5,7 please

 

[mikerickson]

I think this UDF will do what you want

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]

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'.

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.

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:

Sub Demo()
With Selection
  .Value = ParseNumSeq(.Value, "&")
End With
End Sub

 

[nmganey]

I think this UDF will do what you want

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]

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

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]

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

 

[mattsalmon]

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

 

[mikerickson]

try changing these lines

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)