Rick Rothstein
03-06-2012, 03:55 AM
I know this won't come up often but, when it does, I think you will find this function useful. The title for this thread pretty much says it all... the function takes a list of pages and/or page ranges as a text string and expands that list into a list of individual pages. If a dashed range is presented "backwards" (as in the 20-18 part of my example), then the individual pages for it are returned in declining numerical order (20, 19, 18). This function is most useful when called from other VB code as it returns the expand list as an array which can be iterated by your calling code.
Function PagesToPrint(sInput As String) As Variant
Dim X As Long, Z As Long, Temp As String, sNumbers() As String, sRange() As String
If sInput Like "*# #*" Then GoTo Bad
sInput = Replace(sInput, " ", "")
If sInput Like "*[!0-9,-]*" Or sInput Like "*[,-][,-]*" Or _
Not sInput Like "*#" Or Not Val(sInput) Like "[1-9]*" Then GoTo Bad
sNumbers = Split(sInput, ",")
For X = 0 To UBound(sNumbers)
If sNumbers(X) Like "*-*" Then
If sNumbers(X) Like "*-*-*" Then GoTo Bad
sRange = Split(sNumbers(X), "-")
sNumbers(X) = ""
For Z = sRange(0) To sRange(1) Step Sgn(sRange(1) - sRange(0) + 0.1)
sNumbers(X) = sNumbers(X) & "," & Z
Next
sNumbers(X) = Mid(sNumbers(X), 2)
Else
sNumbers(X) = Val(sNumbers(X))
End If
Next
PagesToPrint = Split(Join(sNumbers, ","), ",")
Exit Function
Bad:
PagesToPrint = Array()
MsgBox """" & sInput & """" & vbLf & vbLf & "The specified range of values is incorrectly formed!", vbCritical
End Function
If, for any reason, you would rather see the list returned as a comma delimited text string, then simply change this line of code...
PagesToPrint = Split(Join(sNumbers, ","), ",")
to this...
PagesToPrint = Join(sNumbers, ",")
If you plan to call this modified function as a UDF (user defined function), then you should insert this line of code right before the MsgBox statement at the end of the code in order to suppress the MessageBox when an erroneous argument is passed into the function.
If TypeOf Application.Caller Is Range Then Exit Function
HOW TO INSTALL UDFs
------------------------------------
If you are new to UDFs, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. You can now use PagesToPrint just like it was a built-in Excel function. For example,
=PagesToPrint(A1)
If you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.
Function PagesToPrint(sInput As String) As Variant
Dim X As Long, Z As Long, Temp As String, sNumbers() As String, sRange() As String
If sInput Like "*# #*" Then GoTo Bad
sInput = Replace(sInput, " ", "")
If sInput Like "*[!0-9,-]*" Or sInput Like "*[,-][,-]*" Or _
Not sInput Like "*#" Or Not Val(sInput) Like "[1-9]*" Then GoTo Bad
sNumbers = Split(sInput, ",")
For X = 0 To UBound(sNumbers)
If sNumbers(X) Like "*-*" Then
If sNumbers(X) Like "*-*-*" Then GoTo Bad
sRange = Split(sNumbers(X), "-")
sNumbers(X) = ""
For Z = sRange(0) To sRange(1) Step Sgn(sRange(1) - sRange(0) + 0.1)
sNumbers(X) = sNumbers(X) & "," & Z
Next
sNumbers(X) = Mid(sNumbers(X), 2)
Else
sNumbers(X) = Val(sNumbers(X))
End If
Next
PagesToPrint = Split(Join(sNumbers, ","), ",")
Exit Function
Bad:
PagesToPrint = Array()
MsgBox """" & sInput & """" & vbLf & vbLf & "The specified range of values is incorrectly formed!", vbCritical
End Function
If, for any reason, you would rather see the list returned as a comma delimited text string, then simply change this line of code...
PagesToPrint = Split(Join(sNumbers, ","), ",")
to this...
PagesToPrint = Join(sNumbers, ",")
If you plan to call this modified function as a UDF (user defined function), then you should insert this line of code right before the MsgBox statement at the end of the code in order to suppress the MessageBox when an erroneous argument is passed into the function.
If TypeOf Application.Caller Is Range Then Exit Function
HOW TO INSTALL UDFs
------------------------------------
If you are new to UDFs, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. You can now use PagesToPrint just like it was a built-in Excel function. For example,
=PagesToPrint(A1)
If you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.