Group Consequtive Numbers from a Text String

[DPhilip]

Hi Everyone,

I am in need of a formula or VBA code to achieve the following:

CELL A1: 100,101,102,106,110,111,115,116,117,118,119,120 ---> Output in Cell A2 = 100-102,106,110-111,115-120

Thanks in advance for your help

-Dennis

 

[Joe4]

I created a User Defined Function in VBA to do this. Here is the code:

Function MyGroup(myEntry As String) As String

    Dim myArray() As String
    Dim i As Long
    Dim newString As String
    Dim prevVal As Long
    Dim newVal As Long
    Dim cont As Boolean

'   Split entry into array of values
    myArray = Split(myEntry, ",")
    
'   Ser default to start
    cont = False
    
'   Loop through all values in array
    For i = LBound(myArray) To UBound(myArray)
        newVal = myArray(i)
'       If first value, write first value to string
        If newString = "" Then
            newString = newVal
        Else
'           If new value is one more than previous, mark as continuation
            If newVal = prevVal + 1 Then
                cont = True
            Else
'               Write to string if end of continuation
                If cont = True Then
                    newString = newString & "-" & prevVal & "," & newVal
                    cont = False
'               Write to string if not end of continuation
                Else
                    newString = newString & "," & newVal
                End If
            End If
        End If
'       Make newVal preVal for next loop
        prevVal = newVal
    Next i
    
'   Needed in case last value is a continuation
    If cont = True Then newString = newString & "-" & newVal
    
'   Return built string value
    MyGroup = newString
    
End Function

So to use it, just enter this is cell A2:
=MyGroup(A1)

 

[DPhilip]

Thank you! How would I make the non sequential numbers to show up like this?

100-102,106-106,110-111,115-120

 

[Rick Rothstein]

If your example is representative of the rough size (lengthwise) of all the values you will want to do this to (you could probably go up to about 3 times the length of that example actually), then here is another UDF you can consider using...

[table="width: 500"]
[tr]
	[td]Function MyGroup(myEntry As String) As String
  MyGroup = Replace(Intersect(Rows, Range("A" & Replace(myEntry, ",", ",A")).EntireRow).Address(0, 0), ":", "-")
End Function[/td]
[/tr]
[/table]

 

[DPhilip]

This works great but some of my text strings are 20x longer than my example.

 

[Rick Rothstein]

This works great but some of my text strings are 20x longer than my example.

Then you cannot use my UDF. The limitation is built into the Range object... its text string argument is limited to 255 characters maximum which is why I qualified my posting (your single example did not give me enough information to work with). I might have an idea on how to break the text up into pieces and using my code to process them, but I don't a text string long enough to test on and I do not plan to type one out longhand. If you could post a copy of one of your longest text strings, then I can experiment with it.

 

[Joe4]

Thank you! How would I make the non sequential numbers to show up like this?

100-102,106-106,110-111,115-120

This is different than your original request:

CELL A1: 100,101,102,106,110,111,115,116,117,118,119,120 ---> Output in Cell A2 = 100-102,106,110-111,115-120

Has the need really changed, or are you just playing around to see what else you can do with it?
I ask because I spent a bit of time figuring out the first one, and don't want to devote a lot of time to the changes if they really aren't necessary.

 

[Marcelo Branco]

Another...

Function Group(s As String)
    Dim spl As Variant, currMin As String, currMax As String
    Dim i As Long, strAux As String
    
    spl = Split(s, ",")
    currMin = spl(0)
    currMax = currMin
        
    For i = 1 To UBound(spl)
        If CLng(spl(i)) = CLng(spl(i - 1)) + 1 Then
            currMax = spl(i)
        Else
            strAux = strAux & ", " & currMin & "-" & currMax
            currMin = spl(i)
            currMax = currMin
        End If
    Next i
    Group = Mid(strAux & ", " & currMin & "-" & currMax, 3)
End Function

M.

 

[Rick Rothstein]

Another...

Function Group(s As String)
    Dim spl As Variant, currMin As String, currMax As String
    Dim i As Long, strAux As String
    
    spl = Split(s, ",")
    currMin = spl(0)
    currMax = currMin
        
    For i = 1 To UBound(spl)
        If CLng(spl(i)) = CLng(spl(i - 1)) + 1 Then
            currMax = spl(i)
        Else
            strAux = strAux & ", " & currMin & "-" & currMax
            currMin = spl(i)
            currMax = currMin
        End If
    Next i
    Group = Mid(strAux & ", " & currMin & "-" & currMax, 3)
End Function

Two things...

1) Using the function name Group brings up a "That function is not valid" error message when I put your function into a formula on the worksheet (using XL2010).

2) If I change your function name (I used GroupEm), then your function returns an incorrect answer. For example, I put this in cell A1...

100,101,102,103,104,105,106,107,108,119,121,123,125,126,128,129

and your function returned this to me...

100-100, 119-119, 121-121, 123-123, 125-100, 128-100

Note the multi-cell ranges have the same ending number as starting number and the first cell value is also placed as the last cell value.

 

[Rick Rothstein]

This works great but some of my text strings are 20x longer than my example.

Here is an alternate UDF, not a one-liner though , which can handle any length text argument...

[table="width: 500"]
[tr]
	[td]Function MyGroup(ByVal myEntry As String) As String
  Dim X As Long, Nums() As String, Temp() As String
  Nums = Split(Replace(myEntry, " ", ""), ",")
  For X = 1 To UBound(Nums) - 1
    If Val(Nums(X)) <> Val(Nums(X + 1)) - 1 Then Nums(X) = Nums(X) & "/"
  Next
  Nums = Split(Join(Nums, ","), "/,")
  For X = 0 To UBound(Nums)
    If InStr(Nums(X), ",") Then
      Temp = Split(Nums(X), ",")
      Nums(X) = Temp(0) & "-" & Temp(UBound(Temp))
    Else
      Nums(X) = Nums(X) & "-" & Nums(X)
    End If
  Next
  MyGroup = Join(Nums, ", ")
End Function[/td]
[/tr]
[/table]