Printing a Series of Excel Workbooks with Incremental Serial Numbers

Hi bugmarker,

Welcome to the Forum!

Are we talking about printing 500 copies of one worksheet from one workbook with incremented serials in D5?

You have to be careful because Excel may interpret 01-00010 as January 10, not as a string. So try this, entering and selecting as prompted. I did not hard code D5 as the range in case you need to do this on other sheets or if you change the sheet.

Sub Test()
    Dim iStart As Integer
    Dim iEnd As Integer
    Dim i As Integer
    Dim iLen As Integer
    Dim R As Range
    Dim v As Variant
    
    iStart = CInt(InputBox("Starting number"))
    iEnd = CInt(InputBox("Ending number"))
    Set R = Application.InputBox("What cell has the serial number?", Type:=8)
    
    v = Split(R.Text, "-")
    iLen = Len(v(1))
    R.NumberFormat = "@"
    For i = iStart To iEnd
        R.Value = "'" & v(0) & "-" & Right(String(iLen, "X") & i, iLen)
        R.Value = "'" & Replace(R.Value, "X", "0")
        ActiveSheet.PrintOut
    Next i
End Sub

Thank you all!

I did find a solution, can you advise if this is 'best practice' or if I am coding the long way around the barn?
Sorry...I don't know how to do the nifty screen with the code... :-/


Sub SerialPrintAndIncrement()

Range("SERIAL").Select

'If the last 3 digits are less than 999 (hundreds place), then increment the last 3 digits (to keep the leading zeros in place)
If Right(ActiveSheet.Range("SERIAL"), 3) < 999 Then
ActiveSheet.Range("SERIAL") = Left(ActiveSheet.Range("SERIAL"), 5) & Mid(ActiveSheet.Range("SERIAL"), 6, 3) + 1

'If the last 4 digits are less than 9999 (thousands place), then increment the last 4 digits (to keep the leading zeros in place)
ElseIf Right(ActiveSheet.Range("SERIAL"), 4) < 9999 Then
ActiveSheet.Range("SERIAL") = Left(ActiveSheet.Range("SERIAL"), 4) & Mid(ActiveSheet.Range("SERIAL"), 5, 4) + 1

'If greater than 9,999 then increment the last 5 digits
Else
ActiveSheet.Range("SERIAL") = Left(ActiveSheet.Range("SERIAL"), 3) & Mid(ActiveSheet.Range("SERIAL"), 4, 5) + 1

End If

ActiveWorkbook.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

End Sub

That will work, but it does not meet either of your first two requirements.

1.) Require prompts that ask for a range of serial numbers (i.e. "What is the serial starting value?" "What is the serial ending value?")
2.) Prints the workbook with the starting serial number, increments the serial number and prints again. Continues to loop until the range as given in #1 is completed.

Did you try my code?

Originally Posted by Bernie Deitrick

That will work, but it does not meet either of your first two requirements.

1.) Require prompts that ask for a range of serial numbers (i.e. "What is the serial starting value?" "What is the serial ending value?")
2.) Prints the workbook with the starting serial number, increments the serial number and prints again. Continues to loop until the range as given in #1 is completed.

Did you try my code?

Thank you Bernie!!
I actually put something together before you posted your code.
To answer the question, I put another macro together that asks for the number of serials to print, it then calls the incrementing macro above and loops that way. After trying your code, I think it is a lot more straight forward! A couple quick questions:

1. Can we have a message box that pops up to confirm the number of serials to print ("You will be printing 200 serials, are you sure you want to continue?")? Just as a safe guard? I have the following code but I'm struggling with it popping up each time it sends to the printer:

If MsgBox("You selected to print " & iEnd - iStart & " serials, is this correct?", vbYesNo) = vbNo Then
MsgBox ("Your print job has been cancelled.")
Exit Sub

2. Is there some way to prompt a correction if the input is anything other than 5 characters (the number of ending digits will ALWAYS be a sequence of 5)?


Thank you for your patience!!

Sure - try this one:

Sub Test()
    Dim iStart As Integer
    Dim iEnd As Integer
    Dim i As Integer
    Dim iLen As Integer
    Dim R As Range
    Dim v As Variant
    Dim vbRet As VbMsgBoxResult
    Dim strMsg As String

GetNumbers:
On Error GoTo GetOut

    strMsg = "You cancelled."

    iStart = CInt(InputBox("Starting number"))
    iEnd = CInt(InputBox("Ending number"))
    vbRet = MsgBox("Do you really want to print " & iEnd - iStart + 1 & " pages?", vbYesNo)
    If vbRet = vbNo Then GoTo GetNumbers
    If vbRet = vbCancel Then Exit Sub
    
    strMsg = "Range ""SERIAL"" does not exist."

    Set R = Range("SERIAL")
    
    v = Split(R.Text, "-")
    iLen = Len(v(1))
    R.NumberFormat = "@"
    For i = iStart To iEnd
        R.Value = "'" & v(0) & "-" & Right(String(iLen, "X") & i, iLen)
        R.Value = "'" & Replace(R.Value, "X", "0")
        ActiveSheet.PrintOut
    Next i
    Exit Sub
GetOut:
    MsgBox strMsg
End Sub