[VBA] Print up to a certain number

[sprigelz]

Good morning,
I have the below code that cycles through a drop down, prints to PDF, and output saves into a specific folder. However, I want to be able to put a number in a cell, J4 for example, so that it only prints the first X number to PDF then stops. For example, if there are 100 items in the drop down to print, but J4 shows the number 50. It will only cycle and print the first 50 to PDF and stop after. Can you help?

Public Sub Create_PDFs()

    Dim DesktopFolder As String, sfs As String
    Dim r As Range
   
    sfs = "Ready to Mail"
    With CreateObject("WScript.Shell")
    DesktopFolder = .SpecialFolders("Desktop") & "\"
    sfs = DesktopFolder & sfs
    .Run "cmd /c md " & """" & sfs & """", 0, True
   
    For Each r In Range(Range("K3").Validation.Formula1)
        Range("K3").Value = r.Value
        Sheets("Letter").ExportAsFixedFormat _
            Type:=xlTypePDF, Filename:=sfs & "\" & r & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next
    End With
    
End Sub

 

[Alex Blakenburg]

Would this work for you ?

Just after your Dim statements add:-

    Dim prnMax As Long
    Dim prnCntr As Long
    
    prnMax = Range("J4").Value
    prnCntr = 0

Just before your Next statement (end of the For), add:-

            prnCntr = prnCntr + 1
            If prnCntr = prnMax Then Exit For

 

[sprigelz]

Would this work for you ?

Just after your Dim statements add:-

    Dim prnMax As Long
    Dim prnCntr As Long
   
    prnMax = Range("J4").Value
    prnCntr = 0

Just before your Next statement (end of the For), add:-

            prnCntr = prnCntr + 1
            If prnCntr = prnMax Then Exit For

Alex, Thank you! This works perfectly.

Below is the full code;

Public Sub Create_PDFs()

    Dim DesktopFolder As String, sfs As String
    Dim r As Range
    Dim prnMax As Long
    Dim prnCntr As Long
    
    prnMax = Range("J4").Value
    prnCntr = 0
   
    sfs = "Ready to Mail"
    With CreateObject("WScript.Shell")
    DesktopFolder = .SpecialFolders("Desktop") & "\"
    sfs = DesktopFolder & sfs
    .Run "cmd /c md " & """" & sfs & """", 0, True
   
    For Each r In Range(Range("K3").Validation.Formula1)
        Range("K3").Value = r.Value
        Sheets("Letter").ExportAsFixedFormat _
            Type:=xlTypePDF, Filename:=sfs & "\" & r & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    prnCntr = prnCntr + 1
    If prnCntr = prnMax Then Exit For
    Next
    End With
    
End Sub

 

[Alex Blakenburg]

Alex, Thank you! This works perfectly

That's great. Thanks for letting me know. Happy to help.