How do I export charts based on conditions to PDF using VBA?

[bruhyan]

Hello, I am trying to export 2/6 charts based on the output of a cell. Here's what I am trying to do:
1) For a fixed cell (E2), I will iterate through a column with different values of E2 (1, 1/x and 1/x2). Depending on the value of E2, I will show 2/6 graphs (Outcomes 1, 2 and 3). I wish to save 2 of the graphs as a single PDF before moving to the next value of E2 and generating another PDF.

Currently, my code only allows me to print 1 set of graphs for 1 value of E2 and all 6 graphs appear. Does anyone know how I can edit my code please? Thank you so much

Sub GenerateGraphsAndExportPDFs()
    Dim ws As Worksheet
    Dim chartObject As chartObject
    Dim outcomeRange As Range
    Dim outcomeCell As Range
    Dim outcome As String
    Dim i As Integer
    Dim pdfFolder As String
    Dim wbPath As String
    Dim wbName As String
   
    ' Set the worksheet to work with
    Set ws = ThisWorkbook.Sheets("Summary") ' Change "Sheet1" to your actual sheet name
   
    ' Set the outcome range
    Set outcomeRange = ws.Range("E2:E" & ws.Cells(ws.Rows.Count, "E").End(xlUp).Row) ' Change to your outcome column
   
    ' Prompt user to select a folder for saving PDFs
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            pdfFolder = .SelectedItems(1)
        Else
            Exit Sub ' User canceled folder selection
        End If
    End With
   
    ' Get the workbook path and name
    wbPath = ThisWorkbook.Path
    wbName = ThisWorkbook.Name
   
     ' Loop through each outcome cell
    For Each outcomeCell In outcomeRange
        outcome = outcomeCell.Value ' Get the outcome from the cell
       
        ' Change the fixed cell value (you can adjust the cell reference as needed)
        ws.Range("E2").Value = outcome
       
        ' Show two out of six charts based on the outcome value
        Select Case outcome
            Case "1"
                ws.ChartObjects("Chart 5").Visible = True
                ws.ChartObjects("Chart 2").Visible = True
            Case "1/x"
                ws.ChartObjects("Chart 1").Visible = True
                ws.ChartObjects("Chart 4").Visible = True
            Case "1/x2"
                ws.ChartObjects("Chart 3").Visible = True
                ws.ChartObjects("Chart 6").Visible = True
            ' Add more cases for other outcomes as needed
        End Select
       
        ' Save the workbook
        ThisWorkbook.Save
       
        Set wsTemp = ThisWorkbook.Sheets.Add
       
        With wsTemp
            For Each chrt In ws.ChartObjects
                chrt.CopyPicture
                wsTemp.Paste
                Selection.Top = tp
                Selection.Left = ts
                tp = tp + Selection.Height + 50
            Next
       
        End With
       
    wsTemp.ExportAsFixedFormat Type:=xlTypePDF, FileName:=NewFileName, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
       
        ' Hide all charts for the next iteration
        For Each chartObject In ws.ChartObjects
            chartObject.Visible = False
        Next chartObject
    Next outcomeCell
End Sub

 

[John_w]

Try this:

Sub GenerateGraphsAndExportPDFs()

    Dim ws As Worksheet
    Dim wsTemp As Worksheet
    Dim outcomeRange As Range
    Dim outcomeCell As Range
    Dim outcome As String
    Dim pdfFolder As String, pdfFullName As String
   
    ' Set the worksheet to work with
    Set ws = ThisWorkbook.Worksheets("Summary")
   
    ' Set the outcome range
    Set outcomeRange = ws.Range("E2:E" & ws.Cells(ws.Rows.Count, "E").End(xlUp).Row) ' Change to your outcome column
   
    ' Prompt user to select a folder for saving PDFs
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            pdfFolder = .SelectedItems(1) & "\"
        Else
            Exit Sub ' User canceled folder selection
        End If
    End With

    Set wsTemp = Nothing
   
    ' Loop through each outcome cell
    For Each outcomeCell In outcomeRange
   
        outcome = outcomeCell.Value ' Get the outcome from the cell
       
        pdfFullName = pdfFolder & Replace(outcome, "/", "_") & ".pdf"
       
        ' Change the fixed cell value (you can adjust the cell reference as needed)
        ws.Range("E2").Value = outcome
       
        If wsTemp Is Nothing Then Set wsTemp = ThisWorkbook.Sheets.Add
        wsTemp.Cells.Delete
       
        ' Copy two out of six charts to temporary sheet, based on the outcome value
        Select Case outcome
            Case "1"
                ws.ChartObjects("Chart 5").Copy
                wsTemp.Paste
                ws.ChartObjects("Chart 2").Copy
                wsTemp.Paste
            Case "1/x"
                ws.ChartObjects("Chart 1").Copy
                wsTemp.Paste
                ws.ChartObjects("Chart 4").Copy
                wsTemp.Paste
            Case "1/x2"
                ws.ChartObjects("Chart 3").Copy
                wsTemp.Paste
                ws.ChartObjects("Chart 6").Copy
                wsTemp.Paste
            ' Add more cases for other outcomes as needed
        End Select
       
        wsTemp.ChartObjects(2).Top = wsTemp.ChartObjects(1).Top + wsTemp.ChartObjects(1).Height + 50
        wsTemp.Cells(1).Select
       
        wsTemp.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfFullName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=True
               
    Next outcomeCell
   
    Application.DisplayAlerts = False
    wsTemp.Delete
    Application.DisplayAlerts = True
   
End Sub