Home > Net >  Using VBA code to export from Excel to multiple PDFs based on column value
Using VBA code to export from Excel to multiple PDFs based on column value

Time:01-06

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
  •  Tags:  
  • Related