Formula/program to split an excel sheet into multiple PDF files

Hi,

I'm wondering if this is possible, but basically I have my all customers in one sheet and I'm wondering if there's a way for each customer and their items to be sent to a sperate PDF file (automatic invoices instead of having to copy and paste each customer into a separate excel file then to a PDF).

File.xlsxUntitled.png The reason all my customers are on one sheet because I bulk ship abroad and it's easier that way to make a packing list. I've attached a file that can be worked on and an image explaining the problem further.

OK, I'm happy to help you with this.

A couple of questions;

1. Where do you want the individual PDFs stored? The same pathname as where your workbook is?
2. What Name do you want to give each PDF? I suggest the customer name highlighted in the blue cells...is that OK?
3. There is some detail on your invoice in sheet 1 that I cannot see on Sheet4 for each customer. Address, Invoice No., Email, Telephone comes to mind. I also assume the date you want is todays date?

Oh wow, I never expected anyone to reply. Thank you so much.

1. Yes - basically the folder that the main excel file (Shipment 704) will be in.

2. Yes




3. Luckily our invoicing template isn't that complicated in terms of customer details (as we bulk ship and they pickup from our office)

This is my current way:

I copy and paste the customer's name and items from file "Shipment 704" into excel file "Customer invoice template", fill in the details myself and then convert to PDF. I do that for each customer individually.


Basically I don't need an address or a special invoice number for each customer, those are the same across all customers. Once shipment 704 is done, then I move onto shipment 705 and create a new excel file and so on.



I've attached a new main file, a customer template file and the final PDF.


Would appreciate any help with this but if it's not doable, then I understand. I'm in my 60s and not very tech savvy.

Alice Holmes.pdf

Customer invoice template.xlsx

Shipment 704.xlsx

According to your attachment a VBA procedure for starters to paste only to the template workbook Sheet4 worksheet module.
Once done save it as binary format .xlsb …

Open a shipment workbook before to run this VBA demonstration :

PHP Code: 

Sub Demo1()
         Dim Wb As Workbook, oLi As ListObject
    For Each Wb In Workbooks
          If Wb.Name Like "Shipment *.xlsx" Then Exit For
    Next
    If Not Wb Is Nothing Then
        [F9] = Split(Wb.Name, ".")(0)
        [B11] = Wb.ActiveSheet.[A1]
        [F11] = Date
    For Each oLi In Wb.ActiveSheet.ListObjects
          If oLi.ListRows.Count Then
             [B9,C13] = oLi.Range(0, 3)
             oLi.DataBodyRange.Copy ListObjects(1).HeaderRowRange(2, 1)
             ExportAsFixedFormat 0, Wb.Path & "\" & [B9], 0
             ListObjects(1).DataBodyRange.ClearContents
          End If
    Next
        ThisWorkbook.Saved = True
        Set Wb = Nothing
    End If
End Sub 


► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄

Thank you very much for this.

It kinda worked and 3 PDF files were created. The only issue I had is each PDF file still showed all 3 customers instead of just the customer the file is named under.

Is there a way around this, so when I run the macro each customer and their items will be a separate PDF file without showing the 2 other customers?

There we go! You'll now be flooded with offers to help!

Let me know if this beginners, demonstration for starters does what you want.

If not, I'll help you out with a more advanced one. LOL.

There is no way as it well works as expected on my side so the bad is on yours !
So you must just well follow post #4 direction …

If you are still having trouble with your 'procedure for starters', you may want to try this (see attached);

Option Explicit
Sub PDFSave()

Dim Path As String, TempFileName As String, FileExtStr As String
Dim FileMask As String, StrFile As String
Dim wb As Workbook
Dim tbl As ListObject

Path = GetWorkbookPath(ThisWorkbook) & "\"
FileExtStr = ".PDF"

FileMask = "Shipment *.xlsx"
StrFile = Dir(Path)
UserForm1.Show vbModeless
Application.ScreenUpdating = False
Do While Len(StrFile) > 0
    If StrFile Like FileMask Then
    
        Set wb = Workbooks.Open(Path & StrFile)
        Range("B11").Value = wb.Worksheets("Sheet4").Range("A1").Value
        Range("F9").Value = Left(StrFile, InStr(StrFile, ".") - 1)
        Range("F11").Value = Format(Date, "dd/mm/yyyy")

        For Each tbl In wb.Worksheets("Sheet4").ListObjects
            Range("B9,C13").Value = tbl.Range(0, 3)
            tbl.DataBodyRange.Copy ListObjects(1).HeaderRowRange(2, 1)
            TempFileName = Path & Range("B9").Value & FileExtStr
            ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFileName, Quality:=xlQualityStandard, _
              IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            ListObjects(1).DataBodyRange.ClearContents
            Range("B9,C13").Value = ""
        Next tbl
        Range("B11,F9,F11").Value = ""
        wb.Close
    End If
    StrFile = Dir
Loop

Application.ScreenUpdating = True
Unload UserForm1
MsgBox "All invoices created"
End Sub
Function GetWorkbookPath(Optional wb As Workbook)
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ' Purpose:  Returns a workbook's physical path, even when they are saved in
    '           synced OneDrive Personal, OneDrive Business or Microsoft Teams folders.
    '           If no value is provided for wb, it's set to ThisWorkbook object instead.
    ' Author:   Ricardo Gerbaudo
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    If wb Is Nothing Then Set wb = ThisWorkbook
    
    GetWorkbookPath = wb.Path
    
    If InStr(1, wb.Path, "https://") <> 0 Then
        
        Const HKEY_CURRENT_USER = &H80000001
        Dim objRegistryProvider As Object
        Dim strRegistryPath As String
        Dim arrSubKeys()
        Dim strSubKey As Variant
        Dim strUrlNamespace As String
        Dim strMountPoint As String
        Dim strLocalPath As String
        Dim strRemainderPath As String
        Dim strLibraryType As String
    
        Set objRegistryProvider = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    
        strRegistryPath = "SOFTWARE\SyncEngines\Providers\OneDrive"
        objRegistryProvider.EnumKey HKEY_CURRENT_USER, strRegistryPath, arrSubKeys
        
        For Each strSubKey In arrSubKeys
            objRegistryProvider.GetStringValue HKEY_CURRENT_USER, strRegistryPath & "\" & strSubKey & "\", "UrlNamespace", strUrlNamespace
            If InStr(1, wb.Path, strUrlNamespace) <> 0 Or InStr(1, strUrlNamespace, wb.Path) <> 0 Then
                objRegistryProvider.GetStringValue HKEY_CURRENT_USER, strRegistryPath & "\" & strSubKey & "\", "MountPoint", strMountPoint
                objRegistryProvider.GetStringValue HKEY_CURRENT_USER, strRegistryPath & "\" & strSubKey & "\", "LibraryType", strLibraryType
                
                If InStr(1, wb.Path, strUrlNamespace) <> 0 Then
                    strRemainderPath = Replace(wb.Path, strUrlNamespace, vbNullString)
                Else
                    GetWorkbookPath = strMountPoint
                    Exit Function
                End If
                
                'If OneDrive Personal, skips the GUID part of the URL to match with physical path
                If InStr(1, strUrlNamespace, "https://d.docs.live.net") <> 0 Then
                    If InStr(2, strRemainderPath, "/") = 0 Then
                        strRemainderPath = vbNullString
                    Else
                        strRemainderPath = Mid(strRemainderPath, InStr(2, strRemainderPath, "/"))
                    End If
                End If
                
                'If OneDrive Business, adds extra slash at the start of string to match the pattern
                strRemainderPath = IIf(InStr(1, strUrlNamespace, "my.sharepoint.com") <> 0, "/", vbNullString) & strRemainderPath
                
                strLocalPath = ""
                
                If (InStr(1, strRemainderPath, "/")) <> 0 Then
                    strLocalPath = Mid(strRemainderPath, InStr(1, strRemainderPath, "/"))
                    strLocalPath = Replace(strLocalPath, "/", "\")
                End If
                
                strLocalPath = strMountPoint & strLocalPath
                GetWorkbookPath = strLocalPath
                If Dir(GetWorkbookPath & "\" & wb.Name) <> "" Then Exit Function
            End If
        Next
    End If
    
End Function

@EyadJawad
just curiosity why you just split the files based on Shipment 704 file instead of use two both files?
what I misunderstood or misread? !
what's the useful for Customer invoice template file?
I think this is not practical way despite of you got for perfect solution by Marc & Croweater

How did you go with this? Did you get it working?