Prompt for number of copies to print out

[dixielou]

I read several threads here and they seemed really close to what I need but not quite close enough. I have the following existing code that prompts the user to answer Yes or No when asked if they need to print the NMR form. I would like to add code if they say Yes, it asks how many copies are needed.

*CODE*

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]If MsgBox("Do you want to print the NMR Form?", vbYesNo) = vbYes Then
Sheets("Blank NMR Form").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
End If

*END CODE*

Thank you!
[/FONT]

 

[Joe4]

Try this:

Sub PrintMacro()

    Dim cp As Long

    If MsgBox("Do you want to print the NMR Form?", vbYesNo) = vbYes Then
        On Error GoTo err_chk
        cp = InputBox("How many copies would you like to print?")
        On Error GoTo 0
        If cp > 0 Then
            Sheets("Blank NMR Form").Select
            ActiveWindow.SelectedSheets.PrintOut Copies:=cp, Collate:=True, _
                IgnorePrintAreas:=False
        Else
            GoTo err_chk
        End If
    End If

    Exit Sub
    
    
err_chk:
    MsgBox "You have not entered a valid number greater than 0", vbOKOnly, "ENTRY ERROR!"

End Sub

 

[dixielou]

Thank you Joe4!
I probably should have mentioned that the code I provided is already part of a Sub module. So when I added your code I had to remove the "Sub PrintMacro ()" and "End Sub" in order for it to work. The problem is now even if I enter a correct number for "How many copies...", the error message pops up. Is there a way to give the option to reenter a number instead of just getting an error message and moving on?
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]
[/FONT][FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]
**CODE - FYI - there is more content before this, but it will get long if I post it all. Everything works perfectly up to this point**

Dim cp As Long[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] If MsgBox("Do you want to print the NMR Form?", vbYesNo) = vbYes Then
On Error GoTo err_chk
cp = InputBox("How many copies would you like to print?")
On Error GoTo 0
If cp > 0 Then
Sheets("Blank NMR Form").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=cp, Collate:=True, _
IgnorePrintAreas:=False
Else
GoTo err_chk
End If
err_chk:
MsgBox "Invalid Entry - Use Reprint NMR tab", vbOKOnly, "ENTRY ERROR"
End If

Sheets("Initiation").Select
ActiveSheet.Protect "test", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
Range("B11:B28").Select
Range("B28").Activate
Selection.ClearContents
Range("B1:B7").Select
Range("B7").Activate
Selection.ClearContents
Range("B1").Select
ActiveWorkbook.Save
If MsgBox("Need to enter another NMR?", vbYesNo) = vbNo Then
ActiveWorkbook.Close False
End If
End Sub[/FONT]

 

[Joe4]

You want to place the error handling part of the code at the very end of your code, with an "Exit Sub" statement before it, so if you get that far without any errors, it will exit before running the code, i.e.

Dim cp As Long

If MsgBox("Do you want to print the NMR Form?", vbYesNo) = vbYes Then
    On Error GoTo err_chk
    cp = InputBox("How many copies would you like to print?")
    On Error GoTo 0
    If cp > 0 Then
        Sheets("Blank NMR Form").Select
        ActiveWindow.SelectedSheets.PrintOut Copies:=cp, Collate:=True, _
            IgnorePrintAreas:=False
    Else
        GoTo err_chk
    End If
End If

Sheets("Initiation").Select
ActiveSheet.Protect "test", DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowFiltering:=True
Range("B11:B28").Select
Range("B28").Activate
Selection.ClearContents
Range("B1:B7").Select
Range("B7").Activate
Selection.ClearContents
Range("B1").Select
ActiveWorkbook.Save
If MsgBox("Need to enter another NMR?", vbYesNo) = vbNo Then
    ActiveWorkbook.Close False
End If

[COLOR=#ff0000]Exit Sub

err_chk:
    MsgBox "Invalid Entry - Use Reprint NMR tab", vbOKOnly, "ENTRY ERROR"[/COLOR]

End Sub

 

[dixielou]

Ok - this is closer to what I need but if there is an error it skips protecting the sheet, clearing the entries, etc. Is there a way to give the user a chance to re-enter a number instead of skipping to the next step?

The ideal sequence would be:
"do you need to print?" = yes, "How many copies?", (valid data entry), pages print, Initiation Sheet is protected, contents are cleared, workbook is saved, "Need to enter another NMR?" = yes - workbook stays open or =no - workbook closes

"do you need to print?" = yes, "How many copies?", (invalid data entry), "Invalid entry, please re-enter # of copies to print", pages print, Initiation Sheet is protected, contents are cleared, workbook is saved, "Need to enter another NMR?" = yes - workbook stays open or =no - workbook closes

"do you need to print?" = no, Initiation Sheet is protected, contents are cleared, workbook is saved, "Need to enter another NMR?" = yes - workbook stays open or =no - workbook closes

I like the idea of an error message instead of a wrong entry crashing the code. My users are not of the skill level to know what to do if that happens. Thank you for your time and sharing your knowledge - I have not had any formal VBA training so I am learning "on the fly."
​

 

[Joe4]

OK, try this variation, which will keep asking them for a valid number greater than zero until they enter a good one:

Dim cp As Long

If MsgBox("Do you want to print the NMR Form?", vbYesNo) = vbYes Then
'   Loop through asking them for copies until they enter a valid number
    Do
        On Error Resume Next
        cp = InputBox("How many copies would you like to print?")
        On Error GoTo 0
        If IsNumeric(cp) And cp > 0 Then
            Exit Do
        Else
            MsgBox "You must enter a valid number greater than 0!", vbOKOnly, "ENTRY ERROR!"
        End If
    Loop
'   Print copies
    Sheets("Blank NMR Form").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=cp, Collate:=True, _
        IgnorePrintAreas:=False
End If

Sheets("Initiation").Select
ActiveSheet.Protect "test", DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowFiltering:=True
Range("B11:B28").Select
Range("B28").Activate
Selection.ClearContents
Range("B1:B7").Select
Range("B7").Activate
Selection.ClearContents
Range("B1").Select
ActiveWorkbook.Save
If MsgBox("Need to enter another NMR?", vbYesNo) = vbNo Then
    ActiveWorkbook.Close False
End If

End Sub

 

[dixielou]

BEAUTIFUL! PERFECT! ASTOUNDING!

Thank you so much!

 

[Joe4]

You are welcome.