I modified this script (Macro to convert filtered list to multiple pdf -) to my situation, where the list of records in on file is used to filter the source data to create a PDF for that record. I have pasted the script below. It is creating the PDFs, but the only data included in them is the header row of the source data.
I attached screenshots of the worklist and the source data related to one of the items on the list to show columns that match up. (I can't use add-ins to post the minisheet.)
Thank you for any helps. TM
Some items (PD related) are commented out because they are for use as this evolves to include more files etc.
Sub PracticeToPDF()
'Prepared by Dr Moxie
'Edited by Tanya
Dim wbk_worklist As Workbook
'same as workbook this macro lives in
Dim ws_unique As Worksheet
Dim wbk_SD As Workbook
Dim ws_SD As Worksheet
'Dim wbk_PD as Excel.Workbook
'set and add later
'Dim ws_PD As Worksheet
'set and add later
Dim DataRange As Range
Dim iLastRow As Long
Dim iLastRow_unique As Long
Dim UniqueRng As Range
Dim Cell As Range
Dim LastRow As Long
Dim LastColumn As Long
Dim sfldr As String
Application.ScreenUpdating = False
'Note that the macro will save the pdf files in this active directory so you should save in an appropriate folder
DirectoryLocation = ActiveWorkbook.Path
sfldr = "C:\Separate Reports\"
'Set wbk_SD = Workbooks.Open(fDialog.SelectedItems(1))
Set wbk_SD = Workbooks.Open(sfldr & "HANA_-_Spending_Detail_Report_NARST_-_FT_08_15_19.xlsx")
Set wbk_worklist = Workbooks.Open(sfldr & "SDPD worklist VBA.xlsm")
'Set wbk_PD = Excel.Workbooks("ZANALYSIS_PATTERN PDF source")
'add later
Set ws_SD = wbk_SD.Sheets("Spending Detail Report") 'Amend to reflect the sheet you wish to work with
Set ws_unique = wbk_worklist.Sheets("AllARTnoBP") 'Amend to reflect the sheet you wish to work with
'Find the last row in each worksheet
iLastRow = ws_SD.Cells(Rows.Count, "E").End(xlUp).Row
'changed to column E
iLastRow_unique = ws_unique.Cells(Rows.Count, "A").End(xlUp).Row
'left as column A for Funded Program
With ws_SD
'I've set my range to reflect my headers which are fixed for this report
Set DataRange = ws_SD.Range("$B$2:$O$" & iLastRow)
'autofilter field is 5 as I want to print based on the value in column E
DataRange.AutoFilter Field:=5
'eventually will need to check for data in two columns to determine which source data file to call
Set UniqueRng = ws_unique.Range("A1:A" & iLastRow_unique)
For Each Cell In UniqueRng
DataRange.AutoFilter Field:=5, Criteria1:=Cell
Name = DirectoryLocation & "\" & Cell.Value & " _SD" & ".pdf"
ws_SD.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Name _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
Next Cell
End With
With ws_SD
.Protect Userinterfaceonly:=True, _
DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFormattingColumns:=True, AllowFormattingRows:=True
.EnableOutlining = True
.EnableAutoFilter = True
If .FilterMode Then
.ShowAllData
End If
End With
Application.ScreenUpdating = True
End Sub
I attached screenshots of the worklist and the source data related to one of the items on the list to show columns that match up. (I can't use add-ins to post the minisheet.)
Thank you for any helps. TM
Some items (PD related) are commented out because they are for use as this evolves to include more files etc.
Sub PracticeToPDF()
'Prepared by Dr Moxie
'Edited by Tanya
Dim wbk_worklist As Workbook
'same as workbook this macro lives in
Dim ws_unique As Worksheet
Dim wbk_SD As Workbook
Dim ws_SD As Worksheet
'Dim wbk_PD as Excel.Workbook
'set and add later
'Dim ws_PD As Worksheet
'set and add later
Dim DataRange As Range
Dim iLastRow As Long
Dim iLastRow_unique As Long
Dim UniqueRng As Range
Dim Cell As Range
Dim LastRow As Long
Dim LastColumn As Long
Dim sfldr As String
Application.ScreenUpdating = False
'Note that the macro will save the pdf files in this active directory so you should save in an appropriate folder
DirectoryLocation = ActiveWorkbook.Path
sfldr = "C:\Separate Reports\"
'Set wbk_SD = Workbooks.Open(fDialog.SelectedItems(1))
Set wbk_SD = Workbooks.Open(sfldr & "HANA_-_Spending_Detail_Report_NARST_-_FT_08_15_19.xlsx")
Set wbk_worklist = Workbooks.Open(sfldr & "SDPD worklist VBA.xlsm")
'Set wbk_PD = Excel.Workbooks("ZANALYSIS_PATTERN PDF source")
'add later
Set ws_SD = wbk_SD.Sheets("Spending Detail Report") 'Amend to reflect the sheet you wish to work with
Set ws_unique = wbk_worklist.Sheets("AllARTnoBP") 'Amend to reflect the sheet you wish to work with
'Find the last row in each worksheet
iLastRow = ws_SD.Cells(Rows.Count, "E").End(xlUp).Row
'changed to column E
iLastRow_unique = ws_unique.Cells(Rows.Count, "A").End(xlUp).Row
'left as column A for Funded Program
With ws_SD
'I've set my range to reflect my headers which are fixed for this report
Set DataRange = ws_SD.Range("$B$2:$O$" & iLastRow)
'autofilter field is 5 as I want to print based on the value in column E
DataRange.AutoFilter Field:=5
'eventually will need to check for data in two columns to determine which source data file to call
Set UniqueRng = ws_unique.Range("A1:A" & iLastRow_unique)
For Each Cell In UniqueRng
DataRange.AutoFilter Field:=5, Criteria1:=Cell
Name = DirectoryLocation & "\" & Cell.Value & " _SD" & ".pdf"
ws_SD.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Name _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
Next Cell
End With
With ws_SD
.Protect Userinterfaceonly:=True, _
DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFormattingColumns:=True, AllowFormattingRows:=True
.EnableOutlining = True
.EnableAutoFilter = True
If .FilterMode Then
.ShowAllData
End If
End With
Application.ScreenUpdating = True
End Sub
