Rick Rothstein
01-01-2014, 11:17 PM
To some extent, the code in this article performs a similar action to the one I posted here...
Return individual page numbers from a list of pages and ranges (e.g., 1,5,9-12,20-18) (http://www.excelfox.com/forum/f22/return-individual-page-numbers-from-a-list-of-pages-and-ranges-e-g-1-5-9-12-20-18-a-329/)
except that it allows for the numbers to have text prefixes (as shown in this article's title example), for there to be mixed series using different text prefixes and for the delimiter between series to be spaces and/or commas. So, a small sampling of the kinds of input which the UDF below will be able to process would be...
1,5,9-12,20-18
1 5 9-12 20-15
1,5 9-12, 20 - 15
AB8-AB12
CD3 - CD7 K4, P2-P5 JM8 - JM3
ABCD1-9
XYZ3 - 7
The things to note about the above series is you can mix the space and/or comma delimiter between series items at will, series items be just one item (no dash), the numeric parts of a dashed series can advance either up (A1-A5) or down (B5-B1) and the series will be produced in that order, and the second part of a dashed series can have the text prefix omitted (the text prefix from the first part of that dashed series will be automatically assumed to apply to the second part). One thing which does not show up in the above list, but is permitted, is multiple spaces... you are not restricted to single spaces, use as many as you want as the extra ones will be thrown away during processing. Okay, here is the code that perform the "magic"...
Function ExpandedSeries(ByVal S As String, Optional Delimiter As String = ", ") As Variant
Dim X As Long, Y As Long, Z As Long
Dim Letter As String, Numbers() As String, Parts() As String
S = Chr$(1) & Replace(Replace(Replace(Replace(Application.Trim(R eplace(S, ",", _
" ")), " -", "-"), "- ", "-"), " ", " " & Chr$(1)), "-", "-" & Chr$(1))
Parts = Split(S)
For X = 0 To UBound(Parts)
If Parts(X) Like "*-*" Then
For Z = 1 To InStr(Parts(X), "-") - 1
If IsNumeric(Mid(Parts(X), Z, 1)) And Mid$(Parts(X), Z, 1) <> "0" Then
Letter = Left(Parts(X), Z + (Left(Parts(X), 1) Like "[A-Za-z" & Chr$(1) & "]"))
Exit For
End If
Next
Numbers = Split(Replace(Parts(X), Letter, ""), "-")
If Not Numbers(1) Like "*[!0-9" & Chr$(1) & "]*" Then Numbers(1) = Val(Replace(Numbers(1), Chr$(1), "0"))
On Error GoTo SomethingIsNotRight
For Z = Numbers(0) To Numbers(1) Step Sgn(-(CLng(Numbers(1)) > CLng(Numbers(0))) - 0.5)
ExpandedSeries = ExpandedSeries & Delimiter & Letter & Z
Next
Else
ExpandedSeries = ExpandedSeries & Delimiter & Parts(X)
End If
Next
ExpandedSeries = Replace(Mid(ExpandedSeries, Len(Delimiter) + 1), Chr$(1), "")
Exit Function
SomethingIsNotRight:
ExpandedSeries = CVErr(xlErrValue)
End Function
Return individual page numbers from a list of pages and ranges (e.g., 1,5,9-12,20-18) (http://www.excelfox.com/forum/f22/return-individual-page-numbers-from-a-list-of-pages-and-ranges-e-g-1-5-9-12-20-18-a-329/)
except that it allows for the numbers to have text prefixes (as shown in this article's title example), for there to be mixed series using different text prefixes and for the delimiter between series to be spaces and/or commas. So, a small sampling of the kinds of input which the UDF below will be able to process would be...
1,5,9-12,20-18
1 5 9-12 20-15
1,5 9-12, 20 - 15
AB8-AB12
CD3 - CD7 K4, P2-P5 JM8 - JM3
ABCD1-9
XYZ3 - 7
The things to note about the above series is you can mix the space and/or comma delimiter between series items at will, series items be just one item (no dash), the numeric parts of a dashed series can advance either up (A1-A5) or down (B5-B1) and the series will be produced in that order, and the second part of a dashed series can have the text prefix omitted (the text prefix from the first part of that dashed series will be automatically assumed to apply to the second part). One thing which does not show up in the above list, but is permitted, is multiple spaces... you are not restricted to single spaces, use as many as you want as the extra ones will be thrown away during processing. Okay, here is the code that perform the "magic"...
Function ExpandedSeries(ByVal S As String, Optional Delimiter As String = ", ") As Variant
Dim X As Long, Y As Long, Z As Long
Dim Letter As String, Numbers() As String, Parts() As String
S = Chr$(1) & Replace(Replace(Replace(Replace(Application.Trim(R eplace(S, ",", _
" ")), " -", "-"), "- ", "-"), " ", " " & Chr$(1)), "-", "-" & Chr$(1))
Parts = Split(S)
For X = 0 To UBound(Parts)
If Parts(X) Like "*-*" Then
For Z = 1 To InStr(Parts(X), "-") - 1
If IsNumeric(Mid(Parts(X), Z, 1)) And Mid$(Parts(X), Z, 1) <> "0" Then
Letter = Left(Parts(X), Z + (Left(Parts(X), 1) Like "[A-Za-z" & Chr$(1) & "]"))
Exit For
End If
Next
Numbers = Split(Replace(Parts(X), Letter, ""), "-")
If Not Numbers(1) Like "*[!0-9" & Chr$(1) & "]*" Then Numbers(1) = Val(Replace(Numbers(1), Chr$(1), "0"))
On Error GoTo SomethingIsNotRight
For Z = Numbers(0) To Numbers(1) Step Sgn(-(CLng(Numbers(1)) > CLng(Numbers(0))) - 0.5)
ExpandedSeries = ExpandedSeries & Delimiter & Letter & Z
Next
Else
ExpandedSeries = ExpandedSeries & Delimiter & Parts(X)
End If
Next
ExpandedSeries = Replace(Mid(ExpandedSeries, Len(Delimiter) + 1), Chr$(1), "")
Exit Function
SomethingIsNotRight:
ExpandedSeries = CVErr(xlErrValue)
End Function