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.
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.
In article <[email protected]>,
chchch <[email protected]> wrote:
> 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.
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
"JE McGimpsey" wrote:
> 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.
>
> In article <[email protected]>,
> chchch <[email protected]> wrote:
>
> > 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.
>
Many thanks, JE McGimpsey, that did the trick. You saved me a huge amount of time! Regards,
Ciaran
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
In article <[email protected]>,
CLR <[email protected]> wrote:
> 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.
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" wrote:
> 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
>
>
>
>
> In article <[email protected]>,
> CLR <[email protected]> wrote:
>
> > 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.
>
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
In article <[email protected]>,
CLR <[email protected]> wrote:
> 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, CABGx3
"JE McGimpsey" wrote:
> 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
>
> In article <[email protected]>,
> CLR <[email protected]> wrote:
>
> > I understood how to use the first one, but have no clue here........
>
There are currently 1 users browsing this thread. (0 members and 1 guests)
Posting Permissions
LinkBack URL
About LinkBacks
Register To Reply
Bookmarks