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?
Get help from others!
Recent Questions
Recent Answers
© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP