VBA to conditionally export sheets to pdf files (loop dropdown list & sheets)

Question

Every month I have a dashboard that needs to have a pdf created for each person provided on a drop down list. I created a code that loops through that drop down list and creates a pdf for each person. One of my bosses asked me to add pages to that pdf based on if they meet a certain condition. I created a version of that page on a different worksheet and I want the loop to go through each person on the dropdown list but also attach the other worksheets to the end of that same pdf if they meet the conditions to have that worksheet be attached.

Here is a simplistic version of that excel sheet

So the VBA should loop through the drop down list, check to see if conditions on bottom are met and should print the original sheet and the sheets that meet the conditions.

I have a print area set in all the sheets through page layout, as long as it prints the sheet it should just catch that print area, at least that is what it has been doing so far.

That's the tab that where it loops through the names to reload the original sheet each time it loops through to export, also column two is used in the naming convention

VBA Code:

Sub VenA()
  c00 = "File Path" 'Just change the path
  ar = Sheets("People").ListObjects(1).DataBodyRange
  lm = Format(DateAdd("m", -1, Date), "yyyymm")
  With Sheets("Original")
    For j = 1 To UBound(ar)
      .Range("E3") = ar(j, 1)
      .ExportAsFixedFormat 0, c00 & "Report_" & lm & "_" & ar(j, 2) & ".pdf"
    Next j
  End With
End Sub

So I need to add to that loop for it to check that range in the original sheet each time and if the condition says yes then attach the corresponding worksheets to the exported pdf.

Thank you in advance.

In the for loop I need to do an if statement to check if the measure is yes then add the sheet corresponding to the measure or measures to the export file, every pdf export will include the original sheet, the VBA code I have loops through the different people to reload the original file and export that persons dashboard to pdf so it creates a pdf file for each person. — Juan Maldonado, Aug 14 '21 at 00:05
That's a statement of what you want to accomplish. Have you tried adding the IF statement and where is the problem? — cybernetic.nomad, Aug 16 '21 at 14:48

Juan Maldonado · Accepted Answer · 2021-08-18T17:04:29.827

Edit

Working Code

I am going to leave the bad code at the bottom. I ended up having to use the concepts written in that code and rewrite them. Here is the code I ended up with. If hope this helps someone.

'***********************************************************************
' Purpose: Conditionally export sheets that meet criteria as single PDF  
'***********************************************************************

Sub SheetsAsPDF()

Const cESheets As String = "Sheet1,Sheet2,Sheet3,Sheet4,Sheet5"                  ' Sheet List
Const cSheet As String = "Dashboard"                                            ' Source Worksheet
Const cRange As String = "B105:B108"                                            ' Source Range Address
Const cCrit As Long = 1                                                         ' Criteria

Const c00 As String = "J:\g"    ' File Path

Dim dwb As Workbook    ' Export Workbook
Dim sws As Worksheet   ' Export Worksheet
Dim Cell As Range      ' Current Cell Range (For Each Control Variable)
Dim vntS() As String   ' Sheet Array
Dim j As Long          ' Range Array Element (Row) Counter
Dim i As Long          ' Range Array Element (Row) Counter
Dim iFound As Long     ' Target Element (Row) Counter

ar = Sheets("People").ListObjects(1).DataBodyRange                           ' Get Names
gs = Sheets("Dashboard").ListObjects(1).DataBodyRange                           ' Get Sheets
lm = Format(DateAdd("m", -1, Date), "yyyymm")                                   ' Last Month
vntS = Split(cESheets, ",") ' Copy (split) sheet names from Sheet List to 1D 0-based Sheet Array.

Set sws = ThisWorkbook.Worksheets(Trim(vntS(0)))


With Sheets("Dashboard")
  For j = 1 To UBound(ar)
  .Range("G7") = ar(j, 1)
    For Each Cell In sws.Range(cRange).Cells
        If Cell.Value = cCrit Then
            iFound = 1
            Exit For
        End If
    Next Cell
    If iFound = 0 Then Exit Sub

    

    ' **********************************
    ' Copy Sheets to New Workbook
    ' **********************************

    Application.ScreenUpdating = False

    sws.Copy
    Set dwb = ActiveWorkbook
    iFound = 0
    
    For Each Cell In sws.Range(cRange).Cells
        iFound = iFound + 1
        If Cell.Value = cCrit Then
            sws.Parent.Worksheets(Trim(vntS(iFound))).Copy _
                After:=dwb.Sheets(dwb.Sheets.Count)
        End If
    Next

    ' **********************************
    ' Export New Workbook to PDF
    ' **********************************

    With dwb
        .ExportAsFixedFormat Type:=xlTypePDF, _
                Filename:=c00 & "RVU_Bonus_Report_" & lm & "_" & ar(j, 2) & ".pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False
        .Close False
    End With

    Application.ScreenUpdating = True

    
  Next j
End With

End Sub
'********************************************************

Failed Code

This is what I have so far. It is still not working properly but it is pretty close. It will print out only the worksheets that apply to the first person, it hits an error message after that first loop. It will also export each person but it prints out all sheets regardless of conditions(I explained what I did below). When I have a full solution I will edit and fix the code to help anyone with a similar issue.

Sub SheetsAsPDF()

Const cSheets As String = "Dashboard,Ed165,Ed125,Ed130,Ed122" ' Sheet List
Const cSheet As String = "Dashboard"                   ' Source Worksheet
Const cRange As String = "B104:B108"                    ' Source Range Address
Const cCrit As Long = 1                             ' Criteria


Dim wb As Workbook    ' Export Workbook
Dim Cell As Range     ' Current Cell Range (For Each Control Variable)
Dim vntS As Variant   ' Sheet Array
Dim vntR As Variant   ' Range Array
Dim i As Long         ' Range Array Element (Row) Counter
Dim iTarget As Long   ' Target Element (Row) Counter
c00 = "J:\GenericFilePath" 'Just change the path
ar = Sheets("People").ListObjects(1).DataBodyRange
lm = Format(DateAdd("m", -1, Date), "yyyymm")

' **********************************
' Copy Sheets to New workbook.
' **********************************

' Reset Target Counter.
iTarget = -1

' Copy (split) sheet names from Sheet List to 1D 0-based Sheet Array.
vntS = Split(cSheets, ",")

' Copy Source Range in Source Worksheet to 2D 1-based 1-column Range Array.
vntR = ThisWorkbook.Worksheets(cSheet).Range(cRange)
' Loop through elements (rows) of Range Array (in its first (only) column).
' Note: Not obvious, one might say that the elements (rows) of Sheet Array
' are 'also being looped', but the counter is by 1 less.
With Sheets("Dashboard")
  For j = 1 To UBound(ar)
  .Range("E3") = ar(j, 1)
    For i = 1 To UBound(vntR)
        ' Check if current value in Range Array (vntR) is equal to Criteria
        ' (cCrit). Range Array is 2D (,1).
        If vntR(i, 1) = cCrit Then  ' Current value is equal to Criteria.
            ' Counter (add 1 to) Target Counter (iTarget).
            iTarget = iTarget + 1
            ' Write value of current element (row) of Sheet Array to the
            ' 'iTarget-th' element (row). Note: Values are being overwritten.
            ' Remarks
              ' Sheet Array is a zero-based array i.e. the index number of its
              ' first element is 0, NOT 1. Therefore i - 1 has to be used,
              ' which was previously indicated with 'also being looped'.
              ' Trim is used to avoid mistakes if the Sheet Name List is not
              ' properly written e.g. "Sheet1, Sheet2,Sheet3,  Sheet4".
            vntS(iTarget) = Trim(vntS(i - 1))
          'Else                      ' Current value is NOT equal to Criteria.
        End If
    Next ' Element (row) of Range Array (vntR).
    ' Check if there were any values that were equal to Criteria (cCrit) i.e.
    ' if there are any worksheets to export.
    If iTarget = -1 Then Exit Sub
    ' Resize Sheet Array to the value (number) of Target Counter (iTarget).
    ReDim Preserve vntS(iTarget) ' Note: Values are being deleted.
    ' Copy sheets of Sheet Array to New Workbook.
    ' Remarks
      ' When Copy (for copying sheets) is used without arguments, it will copy
      ' a sheet (array) to a NEW workbook.
    ThisWorkbook.Sheets(vntS).Copy

    ' **********************************
    ' Export New Workbook to PDF
    ' **********************************

    ' Create a reference (wb) to New Workbook which became the ActiveWorkbook
    ' after it had previously been 'created' using the Copy method.
    Set wb = ActiveWorkbook
    ' In New Workbook
    With wb
        ' Export New Workbook to PDF.
        wb.ExportAsFixedFormat Type:=xlTypePDF, _
                Filename:=c00 & "RVU_Bonus_Report_" & lm & "_" & ar(j, 2) & ".pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False
        ' Close New Workbook. False suppresses the message that asks for
        ' saving it.
        wb.Close False
        ' Remarks:
        ' Change this if you might want to save this version of New Workbook
        ' e.g.
        'wb.SaveAs "WB" & Format(Date, "yyyymmdd") & ".xls"
    End With
    
  Next j
End With
End Sub

This is what I have ended up with so far, the while and first for loops through the dropdown., the second loop goes through each of the cells to look for 1 or 0 and if 1 saves them to a new file, the third for loop opens up that saved file and exports it to PDF.

Now the only problem I am having is that when it loops back up to the top I get a Run-time error '9': Subscript out of range. It exports the first person perfectly and only exporting the worksheets that meet the condition. Its breaks on line....

vntS(iTarget) = Trim(vntS(i - 1))

Which I am assuming that it is breaking because either i or iTarget has not reset and its at a number that is already out of the loop. I've tried adding iTarget = 1 to after end with and before next J and that does loop through all the people but prints all 5 worksheets for all of them and does not filter them by the condition for the 4 worksheets based on conditions.

Original code: Excel VBA to export specific sheets based on cell values to PDF

VBA to conditionally export sheets to pdf files (loop dropdown list & sheets)

1 Answers1