Turn a series of numbers in a cell into specific ranges

[Maryellen]

I will have on going spreadsheets that will have one column of comma
delimited numbers.- the cell could contain anywhere from 15 - 150 numbers.

What the desired result would be - in a new column is to turn that series of
numbers into ranges or groupings


for instance in my cell if I had
1,2,3,4,5,6,7,8,12,13,14,15,17,18,19,20,21
my new column would contain
1-8,12-15,17-21

Each spreadsheet might have 15-20 rows - possibly more so a macro or formula
that would do this would be ideal -

I'm honestly jsut stuck on what to search on to find my answer...

 

[Dave Peterson]

This UDF seemed to work ok for me:

Option Explicit
Function GroupTheNumbers(myInStr As String) As String

Dim myOutStr As String
Dim mySplit As Variant
Dim iCtr As Long

myInStr = Replace(myInStr, " ", "")

If Len(myInStr) = 0 Then
myOutStr = ""
Else
mySplit = Split(myInStr, ",")
myOutStr = mySplit(LBound(mySplit))
If UBound(mySplit) = LBound(mySplit) Then
'single number, don't do anything else
'myOutStr is alread the only number
Else
For iCtr = LBound(mySplit) + 1 To UBound(mySplit) - 1
If Val(mySplit(iCtr)) = mySplit(iCtr - 1) + 1 Then
If Val(mySplit(iCtr)) = mySplit(iCtr + 1) - 1 Then
'in a series like 4,5,6
Else
'in a series like 4,5,8
myOutStr = myOutStr & "-" & mySplit(iCtr)
End If
Else
If Val(mySplit(iCtr)) = mySplit(iCtr + 1) - 1 Then
'in a series like 3,5,6
myOutStr = myOutStr & "," & mySplit(iCtr)
Else
'in a series like 3,5,7
myOutStr = myOutStr & "," & mySplit(iCtr)
End If
End If
Next iCtr
'do the last number
If Val(mySplit(UBound(mySplit))) = mySplit(UBound(mySplit) - 1) + 1
Then
'like 7,8
myOutStr = myOutStr & "-" & mySplit(UBound(mySplit))
Else
'like 7,12
myOutStr = myOutStr & "," & mySplit(UBound(mySplit))
End If
End If
End If

GroupTheNumbers = myOutStr

End Function

If you're new to macros:

Debra Dalgleish has some notes how to implement macros here:
http://www.contextures.com/xlvba01.html

David McRitchie has an intro to macros:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

Ron de Bruin's intro to macros:
http://www.rondebruin.nl/code.htm

(General, Regular and Standard modules all describe the same thing.)

========
Short course:

Open your workbook.
Hit alt-f11 to get to the VBE (where macros/UDF's live)
hit ctrl-R to view the project explorer
Find your workbook.
should look like: VBAProject (yourfilename.xls)

right click on the project name
Insert, then Module
You should see the code window pop up on the right hand side

Paste the code in there.

Now go back to excel.
Into a test cell and type:
=GroupTheNumbers(a1)

 

[Maryellen]

this worked perfectly on a PC -any way to turn it into a Mac 2004 friendly
version of it?

 

[Dave Peterson]

Split and Replace were added to VBA in xl2k. I think that's one of the
differences with Mac's. They don't have these two functions (as well as other
stuff).

But you can use application.substitute() instead of Replace and Tom Ogilvy
created a function that does a split in xl97 (and Macs??):

Option Explicit
Function GroupTheNumbers(myInStr As String) As String

Dim myOutStr As String
Dim mySplit As Variant
Dim iCtr As Long

myInStr = Application.Substitute(myInStr, " ", "")

If Len(myInStr) = 0 Then
myOutStr = ""
Else
mySplit = Split97(myInStr, ",")
myOutStr = mySplit(LBound(mySplit))
If UBound(mySplit) = LBound(mySplit) Then
'single number, don't do anything else
'myOutStr is alread the only number
Else
For iCtr = LBound(mySplit) + 1 To UBound(mySplit) - 1
If Val(mySplit(iCtr)) = mySplit(iCtr - 1) + 1 Then
If Val(mySplit(iCtr)) = mySplit(iCtr + 1) - 1 Then
'in a series like 4,5,6
Else
'in a series like 4,5,8
myOutStr = myOutStr & "-" & mySplit(iCtr)
End If
Else
If Val(mySplit(iCtr)) = mySplit(iCtr + 1) - 1 Then
'in a series like 3,5,6
myOutStr = myOutStr & "," & mySplit(iCtr)
Else
'in a series like 3,5,7
myOutStr = myOutStr & "," & mySplit(iCtr)
End If
End If
Next iCtr
'do the last number
If Val(mySplit(UBound(mySplit))) _
= mySplit(UBound(mySplit) - 1) + 1 Then
'like 7,8
myOutStr = myOutStr & "-" & mySplit(UBound(mySplit))
Else
'like 7,12
myOutStr = myOutStr & "," & mySplit(UBound(mySplit))
End If
End If
End If

GroupTheNumbers = myOutStr

End Function
Function Split97(sStr As String, sdelim As String) As Variant
'from Tom Ogilvy
Split97 = Evaluate("{""" & _
Application.Substitute(sStr, sdelim, """,""") & """}")
End Function

 

[Maryellen]

This has worked fabulously so far -except I've hit one snag with it.... and
it might be a limitation of excel... which I can probably work around...

However, the problem that I'm seeing now...

is when I have a cell that contains more than 33 numbers (each seperated by
a comma, then when command runs, I get #value as the result... if I hack off
some of the numbers in the column it works great...

Is there a limit to the number of commas I can have in a cell?


thanks much

 

[Dave Peterson]

My bet is that you have non-numeric data in those strings. And that causes the
function to break.

If you can't find the problem, share the string that causes the trouble.

(Look out for consecutive commas, too.)

This has worked fabulously so far -except I've hit one snag with it.... and
it might be a limitation of excel... which I can probably work around...

However, the problem that I'm seeing now...

is when I have a cell that contains more than 33 numbers (each seperated by
a comma, then when command runs, I get #value as the result... if I hack off
some of the numbers in the column it works great...

Is there a limit to the number of commas I can have in a cell?

thanks much

 

[Maryellen]

the string that's being entered (which is coming from the same source as
numbers that aren't breaking is as follows

178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192,
193, 194, 195, 196, 197, 198, 199, 200, 201, 202, 230, 231, 232, 233, 234,
235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249,
250, 251, 252, 253, 254, 255, 256

If I get rid of the text after 233 - then it works just fine...

 

[Dave Peterson]

Delete the split97 function and replace it with both these functions that come
from MS:

Public Function ReadUntil(ByRef sIn As String, _
sDelim As String, Optional bCompare As Long _
= vbBinaryCompare) As String
Dim nPos As String
nPos = InStr(1, sIn, sDelim, bCompare)
If nPos > 0 Then
ReadUntil = Left(sIn, nPos - 1)
sIn = Mid(sIn, nPos + Len(sDelim))
End If
End Function
Public Function Split97(ByVal sIn As String, Optional sDelim As _
String, Optional nLimit As Long = -1, Optional bCompare As _
Long = vbBinaryCompare) As Variant
Dim sRead As String, sOut() As String, nC As Integer
If sDelim = "" Then
Split97 = sIn
End If
sRead = ReadUntil(sIn, sDelim, bCompare)
Do
ReDim Preserve sOut(nC)
sOut(nC) = sRead
nC = nC + 1
If nLimit <> -1 And nC >= nLimit Then Exit Do
sRead = ReadUntil(sIn, sDelim)
Loop While sRead <> ""
ReDim Preserve sOut(nC)
sOut(nC) = sIn
Split97 = sOut
End Function

The readuntil and split97 functions were stolen from the MSKB:
http://support.microsoft.com/default.aspx?scid=kb;en-us;188007
HOWTO: Simulate Visual Basic 6.0 String Functions in VB5

 

[Maryellen]

Dang you're good...

thanks

Delete the split97 function and replace it with both these functions that come
from MS:

Public Function ReadUntil(ByRef sIn As String, _
sDelim As String, Optional bCompare As Long _
= vbBinaryCompare) As String
Dim nPos As String
nPos = InStr(1, sIn, sDelim, bCompare)
If nPos > 0 Then
ReadUntil = Left(sIn, nPos - 1)
sIn = Mid(sIn, nPos + Len(sDelim))
End If
End Function
Public Function Split97(ByVal sIn As String, Optional sDelim As _
String, Optional nLimit As Long = -1, Optional bCompare As _
Long = vbBinaryCompare) As Variant
Dim sRead As String, sOut() As String, nC As Integer
If sDelim = "" Then
Split97 = sIn
End If
sRead = ReadUntil(sIn, sDelim, bCompare)
Do
ReDim Preserve sOut(nC)
sOut(nC) = sRead
nC = nC + 1
If nLimit <> -1 And nC >= nLimit Then Exit Do
sRead = ReadUntil(sIn, sDelim)
Loop While sRead <> ""
ReDim Preserve sOut(nC)
sOut(nC) = sIn
Split97 = sOut
End Function

The readuntil and split97 functions were stolen from the MSKB:
http://support.microsoft.com/default.aspx?scid=kb;en-us;188007
HOWTO: Simulate Visual Basic 6.0 String Functions in VB5