View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.misc
JE McGimpsey
 
Posts: n/a
Default parsing number ranges

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 ,
chchch 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.