# Print Multiple sheets, based on cell value



## grabrail (Dec 21, 2022)

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


```
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?


----------



## HaHoBe (Dec 21, 2022)

Hi grabrail,

what about


```
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


----------



## grabrail (Dec 22, 2022)

HaHoBe said:


> Hi grabrail,
> 
> what about
> 
> ...


I have just tried this and get an error on this line


```
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


----------



## HaHoBe (Dec 22, 2022)

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


----------



## grabrail (Dec 22, 2022)

HaHoBe said:


> Hi grabrail,
> 
> thanks for the feedback, glad we could solve this.
> 
> ...


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


```
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


----------



## HaHoBe (Dec 22, 2022)

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


```
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


----------



## grabrail (Dec 22, 2022)

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).
> 
> ...


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?


----------



## HaHoBe (Dec 22, 2022)

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



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


```
'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


```
'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


```
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


----------

