Print Multiple sheets, based on cell value

G

grabrail

Board Regular
Joined
Sep 6, 2010
Messages
128
Office Version
  1. 365
Platform
  1. Windows
I have a report, that is made up of multiple worksheets, I am trying to create a printed report of specific worksheets that print as an individual PDF

the following code does this

VBA Code: 
Sub PrintAllSheetToPdf()
    For Each iSheet In ActiveWorkbook.Worksheets
  
    Sheets(Array("Sheet 1", "Sheet 2", "Sheet 3")).Select
    Next iSheet
        With Application.FileDialog(msoFileDialogFolderPicker)
            .Show
            iFolder = .SelectedItems(1) & "\"
        End With
    iFile = InputBox("Enter New File Name", "PDF File Name")
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=iFolder & iFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub

Each worksheet is identical, and what I want to achieve is to only print/PDF the worksheets that contain an entry in a specific cell.

So e.g. if worksheet1 cell A3 contains an entry, worksheet 2 Cell A3 is blank, and worksheet3 cell A3 has an entry, only workshet 1 and 3 will be added to the printout/PDF

How would I achieve this?
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Sort by date Sort by votes
Hi grabrail,

what about

VBA Code: 
Public Sub MrE_1225179_1616312()
' https://www.mrexcel.com/board/threads/print-multiple-sheets-based-on-cell-value.1225179/
  Dim ws            As Worksheet
  Dim strWS         As String
  Dim strFolder     As String
  Dim varRet        As Variant
  
  Const cstrDel As String = ","
  
  'getting information about the sheets
  For Each ws In Worksheets
    If ws.Range("A3").Value <> "" Then
      strWS = strWS & ws.Name & cstrDel
    End If
  Next ws
  
  'getting the folder to which to save to
  With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = -1 Then
      strFolder = .SelectedItems(1) & "\"
    Else
      Exit Sub
    End If
  End With
  'getting the filename to save
  varRet = Application.GetSaveAsFilename(InitialFileName:=strFolder, _
            FileFilter:="PDF Files (*.pdf), *.pdf", _
            Title:="Save Report to Directory")
  'if Cancel is chosen varRet will returm False
  If varRet <> False Then
    'group the worksheets
    Worksheets(Split(Left(strWS, Len(strWS) - 1), cstrDel)).Select
    'print to PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=varRet, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True  'display after creation?
  End If
End Sub

Ciao,
Holger
 
Upvote 0
Solution
HaHoBe said:
Hi grabrail,

what about

VBA Code: 
Public Sub MrE_1225179_1616312()
' https://www.mrexcel.com/board/threads/print-multiple-sheets-based-on-cell-value.1225179/
  Dim ws            As Worksheet
  Dim strWS         As String
  Dim strFolder     As String
  Dim varRet        As Variant
 
  Const cstrDel As String = ","
 
  'getting information about the sheets
  For Each ws In Worksheets
    If ws.Range("A3").Value <> "" Then
      strWS = strWS & ws.Name & cstrDel
    End If
  Next ws
 
  'getting the folder to which to save to
  With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = -1 Then
      strFolder = .SelectedItems(1) & "\"
    Else
      Exit Sub
    End If
  End With
  'getting the filename to save
  varRet = Application.GetSaveAsFilename(InitialFileName:=strFolder, _
            FileFilter:="PDF Files (*.pdf), *.pdf", _
            Title:="Save Report to Directory")
  'if Cancel is chosen varRet will returm False
  If varRet <> False Then
    'group the worksheets
    Worksheets(Split(Left(strWS, Len(strWS) - 1), cstrDel)).Select
    'print to PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=varRet, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True  'display after creation?
  End If
End Sub

Ciao,
Holger
Click to expand...
I have just tried this and get an error on this line

VBA Code: 
Worksheets(Split(Left(strWS, Len(strWS) - 1), cstrDel)).Select

Invalid procedure call or argument

Any ideas?

Ignore, I had accidently made a typo, corrected and now working.

Thank you very much
 
Upvote 0
Hi grabrail,

thanks for the feedback, glad we could solve this.

About typos: one advantage while applying code-tags is that you can click on the symbol Copy to Clipboard in the upper right corner of the code-window and the whole code will be abailable for pasting into the IDE.

Holger
 
Upvote 0
HaHoBe said:
Hi grabrail,

thanks for the feedback, glad we could solve this.

About typos: one advantage while applying code-tags is that you can click on the symbol Copy to Clipboard in the upper right corner of the code-window and the whole code will be abailable for pasting into the IDE.

Holger
Click to expand...
i Do actually have a problem happening now

So first of all I had this code running on a button on a test worksheet and it worked great.

However, I have now re creted the button on a different sheet, where I want it to be, and when it runs, after the folder and file name selection I crashed with an error on this line

VBA Code: 
Worksheets(Split(Left(strWS, Len(strWS) - 1), cstrDel)).Select

error: Select Method of Sheets class failed

not sure why this is happening, as the code is identical
 
Upvote 0
Hi grabrail,

at least in my sample workbook there is no difference between using a Forms-Button (assigning procedure directly) or an ActiveX (calling procedure in the Click-Event).

As I can't figure out why the error is raised maybe this small adjustement can help (justing placing the collection of the sheet names after we have a folder and a name for saving) like

VBA Code: 
Public Sub MrE_1225179_1616312Update()
' https://www.mrexcel.com/board/threads/print-multiple-sheets-based-on-cell-value.1225179/
' Updated: 20221222
' Reason:  altered placement of code
  Dim ws            As Worksheet
  Dim strWS         As String
  Dim strFolder     As String
  Dim varRet        As Variant
 
  Const cstrDel As String = ","
 
  'getting the folder to which to save to
  With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = -1 Then
      strFolder = .SelectedItems(1) & "\"
    Else
      Exit Sub
    End If
  End With
  'getting the filename to save
  varRet = Application.GetSaveAsFilename(InitialFileName:=strFolder, _
            FileFilter:="PDF Files (*.pdf), *.pdf", _
            Title:="Save Report to Directory")
  'if Cancel is chosen varRet will returm False
  If varRet <> False Then
    'getting information about the sheets
    For Each ws In Worksheets
      If ws.Range("A3").Value <> "" Then
        strWS = strWS & ws.Name & cstrDel
      End If
    Next ws
    'group the worksheets
    Worksheets(Split(Left(strWS, Len(strWS) - 1), cstrDel)).Select
    'print to PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=varRet, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True  'display after creation?
  End If
End Sub

Can you check the value for strWs before the Selection (setting a breakpoint or by using Debug.Print strWs for printing the value to the Immediate Window) as one reason may be that all worksheets in the workbook have a blank Cell A3 which would raise Error 5 (VBA Invalid Procedure Call Or Argument Error). Like said above I'm not aware how any Error 1004 (my nightmare error as I find it the hardest to fix as the reason for it may be so many different things) may be raised.

Ciao,
Holger
 
Upvote 0
HaHoBe said:
Hi grabrail,

at least in my sample workbook there is no difference between using a Forms-Button (assigning procedure directly) or an ActiveX (calling procedure in the Click-Event).

As I can't figure out why the error is raised maybe this small adjustement can help (justing placing the collection of the sheet names after we have a folder and a name for saving) like

VBA Code: 
Public Sub MrE_1225179_1616312Update()
' https://www.mrexcel.com/board/threads/print-multiple-sheets-based-on-cell-value.1225179/
' Updated: 20221222
' Reason:  altered placement of code
  Dim ws            As Worksheet
  Dim strWS         As String
  Dim strFolder     As String
  Dim varRet        As Variant
 
  Const cstrDel As String = ","
 
  'getting the folder to which to save to
  With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = -1 Then
      strFolder = .SelectedItems(1) & "\"
    Else
      Exit Sub
    End If
  End With
  'getting the filename to save
  varRet = Application.GetSaveAsFilename(InitialFileName:=strFolder, _
            FileFilter:="PDF Files (*.pdf), *.pdf", _
            Title:="Save Report to Directory")
  'if Cancel is chosen varRet will returm False
  If varRet <> False Then
    'getting information about the sheets
    For Each ws In Worksheets
      If ws.Range("A3").Value <> "" Then
        strWS = strWS & ws.Name & cstrDel
      End If
    Next ws
    'group the worksheets
    Worksheets(Split(Left(strWS, Len(strWS) - 1), cstrDel)).Select
    'print to PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=varRet, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True  'display after creation?
  End If
End Sub

Can you check the value for strWs before the Selection (setting a breakpoint or by using Debug.Print strWs for printing the value to the Immediate Window) as one reason may be that all worksheets in the workbook have a blank Cell A3 which would raise Error 5 (VBA Invalid Procedure Call Or Argument Error). Like said above I'm not aware how any Error 1004 (my nightmare error as I find it the hardest to fix as the reason for it may be so many different things) may be raised.

Ciao,
Holger
Click to expand...
Yes this error throws up when all sheets have blank cell a3, if i put an entry in at least one sheet, it seems to work

if i put an on error resume next at the top of the sub would this stop this error occuring? it is unlikely the button will ever be pressed when all sheets are empty, but just to eliminate the possibility is this a valid option?
 
Upvote 0
Hi grabrail,

the original requirement was

So e.g. if worksheet1 cell A3 contains an entry, worksheet 2 Cell A3 is blank, and worksheet3 cell A3 has an entry, only workshet 1 and 3 will be added to the printout/PDF
Click to expand...

That's the reason for the check of Cell A3. And really I'm no fan of using On Error Resume Next as it will proceed in the code disregarding commands and may produce unwanted results.

Instead of

VBA Code: 
    'getting information about the sheets
    For Each ws In Worksheets
      If ws.Range("A3").Value <> "" Then
        strWS = strWS & ws.Name & cstrDel
      End If
    Next ws

you could use

VBA Code: 
    'getting information about the sheets
    For Each ws In Worksheets
 '     If ws.Range("A3").Value <> "" Then
        strWS = strWS & ws.Name & cstrDel
'      End If
    Next ws

Please try

VBA Code: 
Public Sub MrE_1225179_1616312Update02()
' https://www.mrexcel.com/board/threads/print-multiple-sheets-based-on-cell-value.1225179/
' Updated: 20221222
' Reason:  altered placement of code
  Dim ws            As Worksheet
  Dim strWS         As String
  Dim strFolder     As String
  Dim varRet        As Variant
 
  Const cstrDel     As String = ","
  Const cstrCheckA3 As Boolean = False      'set to True to exclude sheets with empty Cell A3
 
  'getting the folder to which to save to
  With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = -1 Then
      strFolder = .SelectedItems(1) & "\"
    Else
      Exit Sub
    End If
  End With
  'getting the filename to save
  varRet = Application.GetSaveAsFilename(InitialFileName:=strFolder, _
            FileFilter:="PDF Files (*.pdf), *.pdf", _
            Title:="Save Report to Directory")
  'if Cancel is chosen varRet will returm False
  If varRet <> False Then
    'getting information about the sheets
    For Each ws In Worksheets
      If ws.Visible = xlSheetVisible Then
        If cstrCheckA3 Then
          If ws.Range("A3").Value <> "" Then
            strWS = strWS & ws.Name & cstrDel
          End If
        Else
          strWS = strWS & ws.Name & cstrDel
        End If
      End If
    Next ws
    If InStr(1, strWS, cstrDel) > 0 Then
      'group the worksheets
      Worksheets(Split(Left(strWS, Len(strWS) - 1), cstrDel)).Select
      'print to PDF
      ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
          Filename:=varRet, _
          Quality:=xlQualityStandard, _
          IncludeDocProperties:=True, _
          IgnorePrintAreas:=False, _
          OpenAfterPublish:=True  'display after creation?
    Else
      MsgBox "No sheets found for Printout to PDF", vbInformation, "Nothing to do"
    End If
  End If
End Sub

Ciao,
Holger
 
Upvote 0
HaHoBe said:
Hi grabrail,

what about

VBA Code: 
Public Sub MrE_1225179_1616312()
' https://www.mrexcel.com/board/threads/print-multiple-sheets-based-on-cell-value.1225179/
  Dim ws            As Worksheet
  Dim strWS         As String
  Dim strFolder     As String
  Dim varRet        As Variant
 
  Const cstrDel As String = ","
 
  'getting information about the sheets
  For Each ws In Worksheets
    If ws.Range("A3").Value <> "" Then
      strWS = strWS & ws.Name & cstrDel
    End If
  Next ws
 
  'getting the folder to which to save to
  With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = -1 Then
      strFolder = .SelectedItems(1) & "\"
    Else
      Exit Sub
    End If
  End With
  'getting the filename to save
  varRet = Application.GetSaveAsFilename(InitialFileName:=strFolder, _
            FileFilter:="PDF Files (*.pdf), *.pdf", _
            Title:="Save Report to Directory")
  'if Cancel is chosen varRet will returm False
  If varRet <> False Then
    'group the worksheets
    Worksheets(Split(Left(strWS, Len(strWS) - 1), cstrDel)).Select
    'print to PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=varRet, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True  'display after creation?
  End If
End Sub

Ciao,
Holger
Click to expand...
Hi, I have a workbook with 200 Excel sheets, I want to save sheets starting from sheet 50 to last sheet in workbook as pdf format
So that they are displayed in one sheet
 
Upvote 0
Hi sofas,

what about this change

Code: 
'...
  'getting information about the sheets
  For Each ws In Worksheets
    If ws.Index >= 50 Then
      strWS = strWS & ws.Name & cstrDel
    End If
  Next ws
'...
Ciao,
Holger
 
Upvote 1
You must log in or register to reply here.

Similar threads

P
  • Solved
Export Worksheets into a Single PDF using Criteria on each Worksheet
Replies
7
Views
640
jolivanes
jolivanes
S
  • Question Question
Save several sheets of the workbook in one sheet in PDF format
Replies
2
Views
294
sofas
S
T
  • Question Question
Printing to PDF use VBA - Was working but now different sheets are different widths
Replies
1
Views
205
Tanquen
T
KlausW
  • Solved
Save location based on Cell value
Replies
3
Views
195
SunnyAlv
SunnyAlv
Y
  • Solved
Create email with all currently selected sheets attached as individual pdf files
Replies
2
Views
358
Yamezz
Y

Forum statistics

Threads
1,223,911
Messages
6,175,333
Members
452,636
Latest member
laura12345

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top