software

I need to parse cells in a spreadsheet, that contain strings such as
quot;4-6quot; or quot;12-37quot; or quot;40-46quot;, that represent ranges of numbers, in order
to find numbers contained in those ranges. For example, the desired
output for quot;4-6quot; would be quot;4,5,6quot;. Find and replace is not a suitable
tool because I can't predict what strings will be found.--
chchch
------------------------------------------------------------------------
chchch's Profile: www.excelforum.com/member.php...oamp;userid=31970
View this thread: www.excelforum.com/showthread...hreadid=517783Are 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 = quot;,quot;
Const sRANGESEP As String = quot;-quot;
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 quot;*#quot; amp; sRANGESEP amp; quot;#*quot; 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 gt; 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 lt; 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 amp; CStr(nSmall)
If nStep Then
For i = nSmall nStep To nLarge Step nStep
sTemp2 = sTemp2 amp; sDELIM amp; i
Next i
End If
sTemp = Left(sTemp, nLeft - 1) amp; _
Mid(sTemp2, Len(sDELIM) 1) amp; _
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.

In article gt;,
chchch gt; wrote:

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

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, CABGx3quot;JE McGimpseyquot; wrote:

gt; Are these strings delimited in any way?
gt;
gt; This macro doesn't assume that they are (other than by some non-numeric
gt; character):
gt;
gt; Public Sub ReplaceRangeWithList()
gt; Const sDELIM As String = quot;,quot;
gt; Const sRANGESEP As String = quot;-quot;
gt; Dim rCell As Range
gt; Dim nLeft As Long
gt; Dim nRight As Long
gt; Dim nSmall As Long
gt; Dim nLarge As Long
gt; Dim nPos As Long
gt; Dim nStep As Long
gt; Dim i As Long
gt; Dim sTemp As String
gt; Dim sTemp2 As String
gt; If Not TypeOf Selection Is Range Then Exit Sub
gt; For Each rCell In Selection
gt; With rCell
gt; If .Text Like quot;*#quot; amp; sRANGESEP amp; quot;#*quot; Then
gt; sTemp = .Text
gt; nPos = InStr(2, sTemp, sRANGESEP)
gt; Do While nPos
gt; If IsNumeric(Mid(sTemp, nPos - 1, 1)) And _
gt; IsNumeric(Mid(sTemp, nPos 1, 1)) Then
gt; nLeft = nPos - 1
gt; Do While nLeft gt; 1
gt; If Not IsNumeric(Mid(sTemp, nLeft - 1, _
gt; 1)) Then Exit Do
gt; nLeft = nLeft - 1
gt; Loop
gt; nSmall = CLng(Mid(sTemp, nLeft, nPos - nLeft))
gt; nRight = nPos 1
gt; Do While nRight lt; Len(sTemp)
gt; If Not IsNumeric(Mid(sTemp, nRight 1, 1)) _
gt; Then Exit Do
gt; nRight = nRight 1
gt; Loop
gt; nLarge = CLng(Mid(sTemp, nPos 1, nRight - nPos))
gt; nStep = Sgn(nLarge - nSmall)
gt; sTemp2 = sDELIM amp; CStr(nSmall)
gt; If nStep Then
gt; For i = nSmall nStep To nLarge Step nStep
gt; sTemp2 = sTemp2 amp; sDELIM amp; i
gt; Next i
gt; End If
gt; sTemp = Left(sTemp, nLeft - 1) amp; _
gt; Mid(sTemp2, Len(sDELIM) 1) amp; _
gt; Mid(sTemp, nRight 1)
gt; End If
gt; nPos = InStr(nPos 1, sTemp, sRANGESEP)
gt; Loop
gt; On Error Resume Next
gt; Application.EnableEvents = False
gt; .Value = sTemp
gt; Application.EnableEvents = True
gt; On Error GoTo 0
gt; End If
gt; End With
gt; Next rCell
gt; End Sub
gt;
gt;
gt;
gt; Note that this will only work with whole numbers.
gt;
gt; In article gt;,
gt; chchch gt; wrote:
gt;
gt; gt; I need to parse cells in a spreadsheet, that contain strings such as
gt; gt; quot;4-6quot; or quot;12-37quot; or quot;40-46quot;, that represent ranges of numbers, in order
gt; gt; to find numbers contained in those ranges. For example, the desired
gt; gt; output for quot;4-6quot; would be quot;4,5,6quot;. Find and replace is not a suitable
gt; gt; tool because I can't predict what strings will be found.
gt;


Many thanks, JE McGimpsey, that did the trick. You saved me a huge
amount of time! Regards,
Ciaran--
chchch
------------------------------------------------------------------------
chchch's Profile: www.excelforum.com/member.php...oamp;userid=31970
View this thread: www.excelforum.com/showthread...hreadid=517783This version, done as a function, is a bit more robust - it allows a
change in the range separator. For instance,

NumberRangeToList(quot;1-gt;5,8-gt;12,21-gt;19quot;,quot;-gt;quot;)

will return the same result as your example:

Public Function NumberRangeToList( _
ByVal sInput As String, _
Optional sRangeSeparator As String = quot;-quot;, _
Optional sDelimiter As String = quot;,quot;) 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) gt; 0 And nSepCharCount gt; 0 Then
If sTemp Like quot;*#quot; amp; sRangeSeparator amp; quot;#*quot; 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 gt; 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 lt; 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 amp; CStr(nLeftArg)
nStep = Sgn(nRightArg - nLeftArg)
If nStep Then
For i = nLeftArg nStep To _
nRightArg Step nStep
sTemp2 = sTemp2 amp; sDelimiter amp; i
bGoodString = Len(sTemp2) lt;= nMAXCHARS
If Not bGoodString Then Exit Do
Next i
Else
nPos = nPos - nSepCharCount
End If
sTemp = Left(sTemp, nLeftStartChar - 1) amp; _
Mid(sTemp2, Len(sDelimiter) 1) amp; _
Mid(sTemp, nRightEndChar 1)
bGoodString = Len(sTemp) lt;= 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

In article gt;,
CLR gt; wrote:

gt; It even works with 1-5, 8-12, 21-19 all in the same cell, returning
gt; 1,2,3,4,5,8,9,10,11,12,21,20,19
gt;
gt; I don't know when I'll ever use it, but it's going directly into my
gt; goodie-stash.

WOW, you just quot;dissappeared into the cornfieldquot; with that one........lt;ggt;
I understood how to use the first one, but have no clue here........

Vaya con Dios,
Chuck, CABGx3quot;JE McGimpseyquot; wrote:

gt; This version, done as a function, is a bit more robust - it allows a
gt; change in the range separator. For instance,
gt;
gt; NumberRangeToList(quot;1-gt;5,8-gt;12,21-gt;19quot;,quot;-gt;quot;)
gt;
gt; will return the same result as your example:
gt;
gt; Public Function NumberRangeToList( _
gt; ByVal sInput As String, _
gt; Optional sRangeSeparator As String = quot;-quot;, _
gt; Optional sDelimiter As String = quot;,quot;) As Variant
gt; Const nMAXCHARS As Long = 32767
gt; Dim nLeftStartChar As Long
gt; Dim nRightEndChar As Long
gt; Dim nLeftArg As Long
gt; Dim nRightArg As Long
gt; Dim nPos As Long
gt; Dim nStep As Long
gt; Dim nSepCharCount As Long
gt; Dim i As Long
gt; Dim sTemp As String
gt; Dim sTemp2 As String
gt; Dim bGoodString As Boolean
gt;
gt; sTemp = sInput
gt; bGoodString = True
gt; nSepCharCount = Len(sRangeSeparator)
gt; If Len(sInput) gt; 0 And nSepCharCount gt; 0 Then
gt; If sTemp Like quot;*#quot; amp; sRangeSeparator amp; quot;#*quot; Then
gt; nPos = InStr(2, sTemp, sRangeSeparator)
gt; Do While nPos
gt; nLeftStartChar = nPos - 1
gt; nRightEndChar = nPos nSepCharCount
gt; If IsNumeric(Mid(sTemp, nLeftStartChar, 1)) And _
gt; IsNumeric(Mid(sTemp, nRightEndChar, 1)) Then
gt; Do While nLeftStartChar gt; 1
gt; If Not IsNumeric(Mid(sTemp, _
gt; nLeftStartChar - 1, 1)) Then Exit Do
gt; nLeftStartChar = nLeftStartChar - 1
gt; Loop
gt; nLeftArg = CLng(Mid(sTemp, nLeftStartChar, _
gt; nPos - nLeftStartChar))
gt; Do While nRightEndChar lt; Len(sTemp)
gt; If Not IsNumeric(Mid(sTemp, _
gt; nRightEndChar 1, 1)) Then Exit Do
gt; nRightEndChar = nRightEndChar 1
gt; Loop
gt; nRightArg = CLng(Mid(sTemp, _
gt; nPos nSepCharCount, _
gt; nRightEndChar - (nPos nSepCharCount - 1)))
gt; sTemp2 = sDelimiter amp; CStr(nLeftArg)
gt; nStep = Sgn(nRightArg - nLeftArg)
gt; If nStep Then
gt; For i = nLeftArg nStep To _
gt; nRightArg Step nStep
gt; sTemp2 = sTemp2 amp; sDelimiter amp; i
gt; bGoodString = Len(sTemp2) lt;= nMAXCHARS
gt; If Not bGoodString Then Exit Do
gt; Next i
gt; Else
gt; nPos = nPos - nSepCharCount
gt; End If
gt; sTemp = Left(sTemp, nLeftStartChar - 1) amp; _
gt; Mid(sTemp2, Len(sDelimiter) 1) amp; _
gt; Mid(sTemp, nRightEndChar 1)
gt; bGoodString = Len(sTemp) lt;= nMAXCHARS
gt; If Not bGoodString Then Exit Do
gt; End If
gt; nPos = InStr(nPos nSepCharCount, sTemp, _
gt; sRangeSeparator)
gt; Loop
gt; End If
gt; End If
gt; If bGoodString Then
gt; NumberRangeToList = sTemp
gt; Else
gt; NumberRangeToList = CVErr(xlErrValue)
gt; End If
gt; End Function
gt;
gt;
gt;
gt;
gt; In article gt;,
gt; CLR gt; wrote:
gt;
gt; gt; It even works with 1-5, 8-12, 21-19 all in the same cell, returning
gt; gt; 1,2,3,4,5,8,9,10,11,12,21,20,19
gt; gt;
gt; gt; I don't know when I'll ever use it, but it's going directly into my
gt; gt; goodie-stash.
gt;

It can be used as a UDF:

=NumberRangeToList(A1, quot;--gt;quot;)

=NumberRangeTolist(A1,,quot;.quot;)

or as a function within VBA:

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

In article gt;,
CLR gt; wrote:

gt; I understood how to use the first one, but have no clue here........


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

Vaya con Dios,
Chuck, CABGx3quot;JE McGimpseyquot; wrote:

gt; It can be used as a UDF:
gt;
gt; =NumberRangeToList(A1, quot;--gt;quot;)
gt;
gt; =NumberRangeTolist(A1,,quot;.quot;)
gt;
gt; or as a function within VBA:
gt;
gt; Dim rCell As Range
gt; For Each rCell in Selection
gt; With rCell
gt; .Value = NumberRangeToList(.Text, quot;--gt;quot;,quot;,quot;)
gt; End With
gt; Next rCell
gt;
gt; In article gt;,
gt; CLR gt; wrote:
gt;
gt; gt; I understood how to use the first one, but have no clue here........
gt;