TransWikia.com

Iteratively Exporting PDF Reports with Excel

Code Review Asked by PotterFan on December 19, 2021

The goal here is to notate and produce essential PDF reports.

The For loop takes an id number and puts it into specified calculator worksheet. The workbook is set to automatic calculation so all of the necessary values update. Then it copies the result then saves as PDF a set of worksheets labeled Report

The code works perfectly fine for a small number of iterations, but RAM usage increases by about 70 MB after every iteration and that is indeed eventually problematic – is there anything in this code that suggests there could be a memory leak?

What else could be improved?

Main Sub

Sub CalculateEmods()

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Dim emod As Range
    Dim member As Range
    Dim emodsws As Variant
    Dim i As Integer
    Dim RowCount As Integer
    Dim NeededEmods As Range
    
    Set emodsws = ThisWorkbook.Sheets("2020Emods")
    Set NeededEmods = emodsws.Range("A2", Range("A2").End(xlDown))
    
    RowCount = NeededEmods.Rows.Count + 1

    
    For i = 2 To RowCount
        
        Set emod = ThisWorkbook.Sheets("Yearly Breakdown").Range("G334")
        Set member = ThisWorkbook.Sheets("Yearly Breakdown").Range("B2")

    
        'Changes member_ID on "Yearly Breaksown" sheet
        Application.EnableEvents = True
            member.Value2 = emodsws.Range("A" & i).Value2
        Application.EnableEvents = False
        
        'Copies emod and pastes it to Emod Worksheet
        emodsws.Cells(i, 4).Value2 = emod.Value2
        
        Set emod = Nothing
        Set member = Nothing
        
         'Prints Emod Report for member as PDF from function
        SaveReportAsPDFIn2020
        
        emodsws.Select
       
        DoEvents
        Application.Wait Now + #12:00:07 AM#
        Next i
        
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    MsgBox "Emod Reports Created!"
    
    
End Sub

Change Events Macro

Private Sub Worksheet_Change(ByVal Target As Range)

    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    If Intersect(Target, Range("B2")) Then
    
        Dim primaryarray As Range
        Dim secondaryarray As Range
        Dim rw As Range
        
        Set primaryarray = ThisWorkbook.Sheets("Experience Rating Sheet").Range("B9:M322")
        Set secondaryarray = ThisWorkbook.Sheets("Mod Snapshot").Range("A29:E39")
        
        ' unhide all rows before we begin
        primaryarray.EntireRow.Hidden = False
        secondaryarray.EntireRow.Hidden = False
        
        'function recalculates sheets that wil change number of rows to hide
        Call ChangeFooters
        
        'hides rows based on criteria set in function
        For Each rw In primaryarray.Rows
            rw.EntireRow.Hidden = BlankOrZero(rw.Cells(3)) And BlankOrZero(rw.Cells(8))
        Next rw
        
        For Each rw In secondaryarray.Rows
            rw.EntireRow.Hidden = BlankOrZero(rw.Cells(1))
        Next
    
        Set primaryarray = Nothing
        Set secondaryarray = Nothing
        
    End If
        
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub


Function BlankOrZero(c As Range)
    BlankOrZero = Len(c.Value) = 0 Or c.Value = 0
End Function

Function ChangeFooters()

    Dim ws As Worksheet
    Dim Report As Variant
    Dim Calculator As Variant
    
    Set Report = ThisWorkbook.Sheets(Array("Cover Sheet", "Ag Loss Sensitivity", _
                                                        "Experience Rating Sheet", "Loss Ratio Analysis", _
                                                        "Mod Analysis&Strategy Proposal", "Mod Snapshot", _
                                                        "Mod & Potential Savings"))
    
    For Each ws In Report
        ws.PageSetup.RightFooter = Sheet17.Range("B3").Text & Chr(10) & "Mod Effective Date:     " & Sheet17.Range("B4")
    Next ws
    
    Set Report = Nothing
    
End Function

Save as PDF Sub

Sub SaveReportAsPDFIn2020()

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    'Ben Matson : 5-June-2020
    'Test macro to save as pdf with ExportAsFixedFormat

    Dim filename As String
    Dim Folderstring As String
    Dim FilePathName As String
    Dim Report As Variant
    Dim ws As Sheets
    Dim sh As Worksheet
    
    Set ws = Sheets
    Set Report = ThisWorkbook.Sheets(Array("Cover Sheet", "Ag Loss Sensitivity", _
                        "Experience Rating Sheet", "Loss Ratio Analysis", _
                        "Mod Analysis&Strategy Proposal", "Mod Snapshot", _
                        "Mod & Potential Savings"))
    
    
        ws("Cover Sheet").PageSetup.PrintArea = Range("A1:G37").Address
        ws("Ag Loss Sensitivity").PageSetup.PrintArea = Range("A1:H55").Address
        ws("Experience Rating Sheet").PageSetup.PrintArea = Range("A4:L322,A324:M340").Address
        ws("Loss Ratio Analysis").PageSetup.PrintArea = Range("A1:M54").Address
        ws("Mod Analysis&Strategy Proposal").PageSetup.PrintArea = Range("A1:M44").Address
        ws("Mod Snapshot").PageSetup.PrintArea = Range("A1:O69").Address
        ws("Mod & Potential Savings").PageSetup.PrintArea = Range("A1:L80").Address

    
    
    'Name of the pdf file
    filename = ThisWorkbook.Sheets("Cover Sheet").Range("B20") & "_Emod" & "_" & ThisWorkbook.Sheets("Yearly Breakdown").Range("F2") & ".pdf"
    
    'Path Creation and Setting
    Folderstring = "/Users/ben/Desktop/Emod_Calc/Emods_2"
    FilePathName = Folderstring & Application.PathSeparator & filename
    
    'Selecting what sheets to Print
    Report.Select
   
    'Prints as PD
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:= _
    FilePathName, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False
    
    'Clears Print Area
    For Each sh In Report
        sh.PageSetup.PrintArea = ""
    Next sh

    'Clears the variables
    Set Report = Nothing
    filename = ""
    Folderstring = ""
    FilePathName = ""
    
    ThisWorkbook.Sheets("Yearly Breakdown").Select
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
End Sub

The worksheet Change handler may seem like it’s unnecessary for the over-all code but that what updates things that are not formula/calculation related in the Report array of worksheets. I included it here just in case it may be involved in a memory leak.

Is it the Select/ActiveSheet that is causing this and if so what recommendations would you give to optimize even more?

Add your own answers!

Ask a Question

Get help from others!

© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP