parsing number ranges

[chchch]

I need to parse cells in a spreadsheet, that contain strings such as
"4-6" or "12-37" or "40-46", that represent ranges of numbers, in order
to find numbers contained in those ranges. For example, the desired
output for "4-6" would be "4,5,6". Find and replace is not a suitable
tool because I can't predict what strings will be found.

 

[JE McGimpsey]

Are these strings delimited in any way?

This macro doesn't assume that they are (other than by some non-numeric
character):

Public Sub ReplaceRangeWithList()
Const sDELIM As String = ","
Const sRANGESEP As String = "-"
Dim rCell As Range
Dim nLeft As Long
Dim nRight As Long
Dim nSmall As Long
Dim nLarge As Long
Dim nPos As Long
Dim nStep As Long
Dim i As Long
Dim sTemp As String
Dim sTemp2 As String
If Not TypeOf Selection Is Range Then Exit Sub
For Each rCell In Selection
With rCell
If .Text Like "*#" & sRANGESEP & "#*" Then
sTemp = .Text
nPos = InStr(2, sTemp, sRANGESEP)
Do While nPos
If IsNumeric(Mid(sTemp, nPos - 1, 1)) And _
IsNumeric(Mid(sTemp, nPos + 1, 1)) Then
nLeft = nPos - 1
Do While nLeft > 1
If Not IsNumeric(Mid(sTemp, nLeft - 1, _
1)) Then Exit Do
nLeft = nLeft - 1
Loop
nSmall = CLng(Mid(sTemp, nLeft, nPos - nLeft))
nRight = nPos + 1
Do While nRight < Len(sTemp)
If Not IsNumeric(Mid(sTemp, nRight + 1, 1)) _
Then Exit Do
nRight = nRight + 1
Loop
nLarge = CLng(Mid(sTemp, nPos + 1, nRight - nPos))
nStep = Sgn(nLarge - nSmall)
sTemp2 = sDELIM & CStr(nSmall)
If nStep Then
For i = nSmall + nStep To nLarge Step nStep
sTemp2 = sTemp2 & sDELIM & i
Next i
End If
sTemp = Left(sTemp, nLeft - 1) & _
Mid(sTemp2, Len(sDELIM) + 1) & _
Mid(sTemp, nRight + 1)
End If
nPos = InStr(nPos + 1, sTemp, sRANGESEP)
Loop
On Error Resume Next
Application.EnableEvents = False
.Value = sTemp
Application.EnableEvents = True
On Error GoTo 0
End If
End With
Next rCell
End Sub



Note that this will only work with whole numbers.

 

[Guest]

THAT is 'way beyond COOL, JE..........you done good!

It even works with 1-5, 8-12, 21-19 all in the same cell, returning
1,2,3,4,5,8,9,10,11,12,21,20,19

I don't know when I'll ever use it, but it's going directly into my
goodie-stash.

Vaya con Dios,
Chuck, CABGx3

 

[chchch]

Many thanks, JE McGimpsey, that did the trick. You saved me a huge
amount of time! Regards,
Ciaran

 

[JE McGimpsey]

This version, done as a function, is a bit more robust - it allows a
change in the range separator. For instance,

NumberRangeToList("1->5,8->12,21->19","->")

will return the same result as your example:

Public Function NumberRangeToList( _
ByVal sInput As String, _
Optional sRangeSeparator As String = "-", _
Optional sDelimiter As String = ",") As Variant
Const nMAXCHARS As Long = 32767
Dim nLeftStartChar As Long
Dim nRightEndChar As Long
Dim nLeftArg As Long
Dim nRightArg As Long
Dim nPos As Long
Dim nStep As Long
Dim nSepCharCount As Long
Dim i As Long
Dim sTemp As String
Dim sTemp2 As String
Dim bGoodString As Boolean

sTemp = sInput
bGoodString = True
nSepCharCount = Len(sRangeSeparator)
If Len(sInput) > 0 And nSepCharCount > 0 Then
If sTemp Like "*#" & sRangeSeparator & "#*" Then
nPos = InStr(2, sTemp, sRangeSeparator)
Do While nPos
nLeftStartChar = nPos - 1
nRightEndChar = nPos + nSepCharCount
If IsNumeric(Mid(sTemp, nLeftStartChar, 1)) And _
IsNumeric(Mid(sTemp, nRightEndChar, 1)) Then
Do While nLeftStartChar > 1
If Not IsNumeric(Mid(sTemp, _
nLeftStartChar - 1, 1)) Then Exit Do
nLeftStartChar = nLeftStartChar - 1
Loop
nLeftArg = CLng(Mid(sTemp, nLeftStartChar, _
nPos - nLeftStartChar))
Do While nRightEndChar < Len(sTemp)
If Not IsNumeric(Mid(sTemp, _
nRightEndChar + 1, 1)) Then Exit Do
nRightEndChar = nRightEndChar + 1
Loop
nRightArg = CLng(Mid(sTemp, _
nPos + nSepCharCount, _
nRightEndChar - (nPos + nSepCharCount - 1)))
sTemp2 = sDelimiter & CStr(nLeftArg)
nStep = Sgn(nRightArg - nLeftArg)
If nStep Then
For i = nLeftArg + nStep To _
nRightArg Step nStep
sTemp2 = sTemp2 & sDelimiter & i
bGoodString = Len(sTemp2) <= nMAXCHARS
If Not bGoodString Then Exit Do
Next i
Else
nPos = nPos - nSepCharCount
End If
sTemp = Left(sTemp, nLeftStartChar - 1) & _
Mid(sTemp2, Len(sDelimiter) + 1) & _
Mid(sTemp, nRightEndChar + 1)
bGoodString = Len(sTemp) <= nMAXCHARS
If Not bGoodString Then Exit Do
End If
nPos = InStr(nPos + nSepCharCount, sTemp, _
sRangeSeparator)
Loop
End If
End If
If bGoodString Then
NumberRangeToList = sTemp
Else
NumberRangeToList = CVErr(xlErrValue)
End If
End Function

 

[Guest]

WOW, you just "dissappeared into the cornfield" with that one........<g>
I understood how to use the first one, but have no clue here........

Vaya con Dios,
Chuck, CABGx3

 

[JE McGimpsey]

It can be used as a UDF:

=NumberRangeToList(A1, "-->")

=NumberRangeTolist(A1,,".")

or as a function within VBA:

Dim rCell As Range
For Each rCell in Selection
With rCell
.Value = NumberRangeToList(.Text, "-->",",")
End With
Next rCell

 

[Guest]

Well, that's interesting.....thank you very much kind Sir......

Vaya con Dios,
Chuck, CABGx3