Hi @ExperimentOne,
You're in luck, I had done something similar for my former employer so I just modified the code a bit to better suit your needs.
Full disclaimer, I am not a VBA developer so I guarantee there's a better way to do this... but this works.
There's a few assumptions made here. You may need to modify this according to your environment.
You will need a folder "C:\export\". This is where the pdf will go.
The code assumes your data is on "sheet1"
Your data will have to be sorted manually by location (if not already done).
The code will create then delete a sheet called "Temp". If you already have one, modified either your sheet name of the code, otherwise you will lose whatever data you have on "Temp"
I took a guess that the data started at row 2 (row 1 being a header).
I tried to add some comments in the code so you can modify to your liking.
I suggest you assign this code to a button for ease of access.
------------Code below-----------
Sub PDFThis()
Dim i As Integer
Dim count As Integer
Dim subcount As Integer
Dim location As String
Dim newlocation As String
location = Range("A2").Value
subcount = 0
'This will count how many rows has data in column A
With ActiveSheet
count = .Cells(.Rows.count, "A").End(xlUp).Row
End With
'Create a temporary sheet called "Temp"
Sheets.Add.Name = "Temp"
'double the width of column A to Z. You will probably want to adjust this to better fit your needs.
With Worksheets("Temp").Columns("A:Z")
.ColumnWidth = .ColumnWidth * 2
End With
'Assuming you have a header in row 1, this will loop through the number of rows you have starting with row #2.
'If you do not have a header or your info start past row #2, modify it here.
For i = 2 To count
Sheets("Sheet1").Select
newlocation = Range("A" & i).Value
'Detect whether this location has been processed or not
If newlocation = location Then
'This location has been processed so add the new info on a new row
subcount = subcount + 1
Sheets("Sheet1").Select
Sheets("Sheet1").Rows(i).Copy
Sheets("Temp").Select
Sheets("Temp").Rows(subcount).Select
Sheets("Temp").Paste
Else
'This location has not been processed so PDF whatever is in Temp sheet then delete temp sheet.
subcount = 1
location = Range("A" & i).Value
'Export the sheet named "Temp" to PDF. Make sure you have a folder named "export" at the root of C: (c:\export\) or modify the code below accordingly.
'Also, the PDF name for each location will be the location name. Assuming your location is in column A. If not, modify it in the code below. (Range("A1").Value)
Sheets("Temp").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"c:\export\" & Range("A1").Value, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
'Delete the sheet named "Temp" and remove the confirmation prompt.
Application.DisplayAlerts = False
Sheets("Temp").Delete
'Re-establish the confirmation prompt. Best practice I guess.
Application.DisplayAlerts = True
'Re-create a temporary sheet called "Temp"
Sheets.Add.Name = "Temp"
'double the width of column A to Z. You will probably want to adjust this to better fit your needs.
With Worksheets("Temp").Columns("A:Z")
.ColumnWidth = .ColumnWidth * 2
End With
'Copy the row info from "sheet1" to "Temp"
Sheets("Sheet1").Select
Sheets("Sheet1").Rows(i).Copy
Sheets("Temp").Select
Sheets("Temp").Rows(subcount).Select
Sheets("Temp").Paste
End If
Next i
'PDF the last set of entries found in "Temp"
Sheets("Temp").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"c:\export\" & Range("A1").Value, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
'Delete the sheet named "Temp" and remove the confirmation prompt.
Application.DisplayAlerts = False
Sheets("Temp").Delete
'Re-establish the confirmation prompt. Best practice I guess.
Application.DisplayAlerts = True
End Sub
