Export Worksheets into a Single PDF using Criteria on each Worksheet

[PaulEpic]

I have a workbook template (template.xltm) that has 150 premade worksheets. Obviously from this template I create *.xlsm files. These individual workbooks can grow up to 300 worksheets. I need a macro/VBA that looks at the specific Cell A1 on every worksheet and then prints that worksheet if it is not equal to 0 while also exporting it to a single PDF. The code below is the closest I have found on the web but it prints individual PDFs and not a SINGLE PDF. It meets my criteria except I end up with a ton of PDFs that I then need to merge using Adobe Acrobat. Some A1s will have positive numbers, negative numbers and/or text. But if it is 0 (zero), do not print.

Works but Prints many PDFs instead of a Single PDF.
'-------------------------------------------------------------------------------
Sub Save_as_Pdfs()
'-------------------------------------------------------------------------------
' Saves marked sheets as PDF file.

Const PDF_path = "C:\Reports"

Dim Snr As Integer
Dim Name As String

'Process all sheets in workbook
For Snr = 1 To ActiveWorkbook.Sheets.Count
Sheets(Snr).Activate
'Only print if A1 contains "Y"
If Cells(1, "A").Value <> "0" Then
Name = PDF_path & Snr & ActiveSheet.Name & Cells(1, "A").Value & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Name, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
Next Snr
End Sub

*I am also in process of moving to SharePoint (excel web) so obviously VBA doesn't work. My work around is to download any workbooks that I need to run this macro on to my desktop and then run the macro. I'm curious if there is any way to turn this into an office script and output to a specific document folder on SharePoint?

 

[Special-K99]

But the PDF Name is INSIDE the loop.
As Name changes (because the sheet name changes) the PDF name will change.
So you are creating lots of different PDFs, but you said you only want one PDF.

Does this work (am no VBA expert, this may just export one sheet to the PDF file)?

Const PDF_path = "C:\Reports"
  
   Dim Snr As Integer
   Dim Name As String

   'Process all sheets in workbook
   For Snr = 1 To ActiveWorkbook.Sheets.Count
       'Only print if A1 contains "Y"
       If Cells(1, "A").Value <> "0" Then
       Sheets(Snr).Select
       End If
   Next Snr

         Name = "Reports.pdf"
           ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Name, _
               Quality:=xlQualityStandard, IncludeDocProperties:=True, _
               IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub

If it doesn't work can you base something on this?

 

[PaulEpic]

But the PDF Name is INSIDE the loop.
As Name changes (because the sheet name changes) the PDF name will change.
So you are creating lots of different PDFs, but you said you only want one PDF.

Does this work (am no VBA expert, this may just export one sheet to the PDF file)?

Const PDF_path = "C:\Reports"
 
   Dim Snr As Integer
   Dim Name As String

   'Process all sheets in workbook
   For Snr = 1 To ActiveWorkbook.Sheets.Count
       'Only print if A1 contains "Y"
       If Cells(1, "A").Value <> "0" Then
       Sheets(Snr).Select
       End If
   Next Snr

         Name = "Reports.pdf"
           ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Name, _
               Quality:=xlQualityStandard, IncludeDocProperties:=True, _
               IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub

If it doesn't work can you base something on this?

When running this Macro, nothing happens. It does not error out and appears to run successfully but a PDF is never created. I completely agree with your response that the PDF portion needs to be outside the IF iterations, but I have been unsuccessful in getting creating code that works. I have tried to use array's, similar to the video you posted, but they are always using constant sheet names or preset values. I have been unable to cycle through sheets and determine if that worksheet needs to be included in the PDF Workbook Export.

 

[jolivanes]

This will make a single PDF and save it on your desktop.
I don't do SharePoint so you'll have to do that yourself.
We can leave a few lines out to make the code shorter (combine the "For i" and the "For j") but that would be for later.

Sub Like_So()
Dim prShts, i As Long, j As Long, a As String, pdf As String
a = ActiveSheet.Name
pdf = CreateObject("WScript.Shell").Specialfolders("Desktop") & "\My_New_Book.pdf"    '<---- Change as required
Application.ScreenUpdating = False
    For i = 1 To ThisWorkbook.Worksheets.Count
        If Sheets(i).Cells(1, 1).Value <> 0 Then prShts = prShts & "|" & Worksheets(i).Name
    Next i
    prShts = Split(Mid(prShts, 2), "|")
    For j = LBound(prShts) To UBound(prShts)
        Worksheets(prShts(j)).Select False
    Next j
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdf
Sheets(a).Select
Application.ScreenUpdating = True
End Sub

 

[jolivanes]

If the first sheet in the PDF file is not a sheet that should be part of the file, insert this line

    Sheets(prShts(j)).Activate

before this line

    For j = LBound(prShts) To UBound(prShts)

 

[PaulEpic]

This will make a single PDF and save it on your desktop.
I don't do SharePoint so you'll have to do that yourself.
We can leave a few lines out to make the code shorter (combine the "For i" and the "For j") but that would be for later.

Sub Like_So()
Dim prShts, i As Long, j As Long, a As String, pdf As String
a = ActiveSheet.Name
pdf = CreateObject("WScript.Shell").Specialfolders("Desktop") & "\My_New_Book.pdf"    '<---- Change as required
Application.ScreenUpdating = False
    For i = 1 To ThisWorkbook.Worksheets.Count
        If Sheets(i).Cells(1, 1).Value <> 0 Then prShts = prShts & "|" & Worksheets(i).Name
    Next i
    prShts = Split(Mid(prShts, 2), "|")
    For j = LBound(prShts) To UBound(prShts)
        Worksheets(prShts(j)).Select False
    Next j
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdf
Sheets(a).Select
Application.ScreenUpdating = True
End Sub

Thank you so much!!! I have spent days and hours trying to figure this out. This worked perfectly. For anyone else trying to do this: you can change the CreateObject("WScript.Shell").Specialfolders("Desktop") to the directory you want so it doesn't save to desktop. EX.

Change this line from:
pdf = CreateObject("WScript.Shell").Specialfolders("Desktop") & "\My_New_Book.pdf" '<---- Change as required
to:
pdf = "C:\users\User Name\OneDrive" & "\My_New_Book.pdf" '<---- Change as required

I also added a few lines to make the PDF File Name the Original Excel Workbook Name.


Sub Like_So()
Dim prShts, i As Long, j As Long, a As String, pdf As String, GetWorkbookName As String
GetWorkbookName = Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".") - 1)

a = ActiveSheet.Name
pdf = "c:\Users\User Name\" & GetWorkbookName & ".pdf" '<---- Change "c:\Users\User Name\" as required for specific folder be sure to keep slash at the end
Application.ScreenUpdating = False
For i = 1 To ThisWorkbook.Worksheets.Count
If Sheets(i).Cells(1).Value <> 0 Then prShts = prShts & "|" & Worksheets(i).Name
Next i
prShts = Split(Mid(prShts, 2), "|")
For j = LBound(prShts) To UBound(prShts)
Worksheets(prShts(j)).Select False
Next j
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdf
Sheets(a).Select
Application.ScreenUpdating = True
End Sub



Jolivanes, Thanks AGAIN!!! I am honestly not concerned with saving a few lines. This Marco made short work of one of my largest workbooks i have.

 

[jolivanes]

Thank you very much for the update.
Very kind of you to show us your final code.
Good Luck.

 

[jolivanes]

I was asleep at the wheel. Sorry about that.
Forget about Post #5 altogether.
In your code in Post #6, change this

For j = LBound(prShts) To UBound(prShts)
Worksheets(prShts(j)).Select False
Next j

to this

Sheets(prShts).Select