I have a large spreadsheet of data that I'm trying to export to multiple PDFs. The spreadsheet contains manual page breaks as the "inherited" value of Column A changes. The data in the spreadsheet looks like this:
| Name | Date | Time | Value |
|---|---|---|---|
| Peter | 14/01/2021 | 11:37 | $15.90 |
| 14/01/2021 | 12:19 | $4.75 | |
| 14/01/2021 | 13:48 | $14.25 | |
| 14/01/2021 | 14:11 | $7.50 | |
| 14/01/2021 | 14:28 | $11.70 | |
| 14/01/2021 | 15:22 | $3.45 | |
| 15/01/2021 | 09:32 | $15.60 | |
| 15/01/2021 | 11:03 | $8.20 | |
| 15/01/2021 | 15:16 | $12.55 | |
| 15/01/2021 | 16:49 | $5.35 | |
| Paul | 14/01/2021 | 12:10 | $14.30 |
| 14/01/2021 | 15:53 | $9.95 | |
| 15/01/2021 | 11:14 | $19.15 | |
| 15/01/2021 | 14:33 | $6.85 | |
| Mary | 14/01/2021 | 15:55 | $7.95 |
| 15/01/2021 | 11:18 | $19.95 | |
| 15/01/2021 | 15:59 | $12.25 | |
| 15/01/2021 | 16:11 | $9.25 |
In the spreadsheet, there are manual page breaks immediately above "Paul" and "Mary" respectively, so that each person would be printed on a separate page. Therefore, the desired output is that this is emulated in PDF export; i.e. everything from the row where it says "Peter" in column A until the row immediately before where it says "Paul" is printed to a single PDF file, then everything from where it say "Paul" in column A until the row immediately before where it says "Mary" in another, etc.
I've modified some code found online somewhere, but if one person's data spans multiple pages (which it will), it only prints out one page. I suppose part of the issue is that a second page would not have anyone's name on it, so instead of saving it as "Peter data.pdf" is saves as " data.pdf" which gets subsequently overwriten as it works through the entire spreadsheet and encounter more multiple-page people. I also note that the To and From is calling the same variable (p), so it's limiting to one page.
Set ThisSheet = Worksheets("Sheet1")
ExportDir = "C:\Users\Julian\Export\"
NrPages = ThisSheet.HPageBreaks.Count 'This is including automatic page breaks as well as manual ones
For p = 1 To NrPages
If p = 1 Then
RwStart = 1
Else
RwStart = ThisSheet.HPageBreaks(p - 1).Location.Row
End If
FoundName = Replace(ThisSheet.Range("A" & RwStart).Value, "/", "-") 'Sometimes two people are grouped together and dividied with a forward slash, so changing that to a hyphen for the export name
ExportName = FoundName & " data.pdf"
ThisSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ExportDir & ExportName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=p, To:=p, OpenAfterPublish:=False
Next
Set ThisSheet = Nothing
It's not ideal to populate down the blank cells with the name so that each row has a name.
In a perfect world, it would output a new PDF at every manual page break and ignore all automatic page breaks.
I'm looking for some way to achieve this logic: for each name in column A, select rows until [next name in column A less 1 row] and print selection.
Is this achievable? My knowledge of VBA is zero and I've been fumbling away as best I can.
Many thanks in advance for any help.
CodePudding user response:
"Is this achievable?" - Yes.
The Range.End property is what you're looking for. It would allow you to measure the number of blank rows between each entry in Column A. With Range.End you can create a loop that skims down Column A and builds each "page" of data based on every non-blank cell it finds.
See the comments in the following code for more explanation:
Sub Main()
Dim ws As Worksheet
Set ws = ActiveSheet ' If you want to target a specific worksheet, change this.
'Export all pages to PDF
ExportAllPages ws
End Sub
Sub ExportAllPages(ws As Worksheet)
Const STARTING_ROW As Long = 2 'First row containing data on the sheet.
Const NUMBER_OF_COLUMNS As Long = 4 'Number of columns containing data on the sheet.
Const ExportDir As String = "C:\Users\Julian\Export\"
'Finding the last used row of the sheet
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
Dim r As Long
For r = STARTING_ROW To LastRow
'Skimming down column A to find the next non-blank cell
Dim PageEnd As Long
PageEnd = ws.Cells(r, 1).End(xlDown).Row - 1
'Exception: There are a series of non-blank cells in column A
'Resolution: Set PageEnd to r instead of using .End(xlDown)
If ws.Cells(r 1, 1) <> "" Then PageEnd = r
'If we hit the bottom of the worksheet, trim to the last used row.
If PageEnd > LastRow Then PageEnd = LastRow
'Defining the current printable page area
Dim CurrentPage As Range
Set CurrentPage = ws.Range(ws.Cells(r, 1), ws.Cells(PageEnd, NUMBER_OF_COLUMNS))
ws.PageSetup.PrintArea = CurrentPage.Address
Dim FoundName As String, ExportName As String
FoundName = Replace(ws.Cells(r, 1).Value, "/", "-") 'Sometimes two people are grouped together and dividied with a forward slash, so changing that to a hyphen for the export name
ExportName = FoundName & " data.pdf"
ws.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ExportDir & ExportName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'Moving the loop index, skipping the rows of the current page
r = PageEnd
Next
End Sub
