Create & Save filtered lists into PDF

alkaline3 · Jan 21st 2020

Hi there, I've seen variations of this problem on this site (like here) as well as others, but I'm pretty much brand new to VBA so I'm struggling to fit other examples to my specific use case. The Excel Workbook I'm using has 9 tabs, 3 of which are data dump only tabs that, when filtered, generate the results on the other 6 tabs. The filter criteria is the same on each of the 3 tabs, in this case I'm using names. The process is like this:

1. Filter Swanson, Ron on the 3 data dump tabs (name to be filtered is located in same column on each tab)

2. Highlight the other 6 tabs

3. Save as a PDF with password protection and page numbers

4. Repeat with new name

This seems a bit tricky, especially because I'd like the PDF outputs to be password protected and have page numbers. How can I have a macro that filters a name on 3 tabs and saves down the filtered result as a PDF with a password and page number? Any guidance is helpful. Thank you.

**royUK** · Jan 21st 2020

I don't believe you can add a password successfully without third party pdf software

alkaline3 · Jan 21st 2020

Thank you for your quick reply! That's helpful, I can take that step out if it isn't possible. So it would be same setup except not password protect.

alkaline3 · Jan 22nd 2020

Here is some code that I tried:

Code

```
Option Explicit
Private colNames As Collection
Sub test()
 
 Dim lngItem As Long
 
 Application.ScreenUpdating = False
 
 MakeCollection
 
 For lngItem = 1 To colNames.Count
 
 '// is this causing the '1.xlsx' to '9.xlsx' issue?
 ThisWorkbook.Sheets.Copy
 
 RemoveHiddenRows ActiveWorkbook.Sheets("DataTab1"), colNames(lngItem)

 '// Save to the same directory as this workbook
 With ActiveWorkbook
 .SaveAs Filename:=ThisWorkbook.Path & "\" & colNames(lngItem), AddToMRU:=False, FileFormat:=xlWorkbookDefault
 .Close
 End With
 
 Next
 
 With Application
 .ScreenUpdating = True
 .StatusBar = False
 End With
 
 MsgBox "Finished...", vbInformation
 
End Sub
Private Sub RemoveHiddenRows(ws As Excel.Worksheet, strName As String)
 Dim oRow As Range
 Dim rng As Range
 Dim myRows As Range
 With ws

 Set myRows = Intersect(.Range("A:A").EntireRow, .UsedRange)
 If myRows Is Nothing Then Exit Sub

 .AutoFilterMode = False
 
 '//don't need explicit call out to range, but wasn't sure how to edit
 With .Range("A2:AD" & ws.Range("A" & Rows.Count).End(xlUp).Row)
 .AutoFilter
 '// Filter on Col 2 = passed name
 .AutoFilter Field:=2, Criteria1:=strName, Operator:=xlFilterValues
 End With
 
 End With
 
 '// Loop through cells in Col 2. If the row is not visible
 '// then add to a range. The entire range is deleted later
 For Each oRow In myRows.Columns(2).Cells
 If oRow.EntireRow.Hidden Then
 If rng Is Nothing Then
 Set rng = oRow
 Else
 Set rng = Union(rng, oRow)
 End If
 End If
 Next
 If Not rng Is Nothing Then rng.EntireRow.Delete
 
 '// And turn off autofiltering
 ws.AutoFilterMode = False
 
End Sub
Private Sub MakeCollection()
 
 Dim r As Excel.Range
 Dim c As Excel.Range
 Dim ws As Excel.Worksheet
 
 Set colNames = New Collection
 Set ws = ThisWorkbook.Sheets("DataTab1")
 
 On Error Resume Next
 
 For Each c In ws.Range(ws.Range("A2"), ws.Range("B" & Rows.Count).End(xlUp))
 colNames.Add c.Text, c.Text
 Next
 
End Sub

Display More

There are a few issues with this code

only filters on one data tab
Although it seems to filter for Swanson, Ron properly and saves out an excel fairly quickly, going to the next name slows it down significantly and it filters everyone out except the first two names (ie Swanson, Ron and Knope, Leslie)
creates dummy excel files named '1.xlsx' up to '9.xlsx' (before I stopped it) for just 3 filtered names.

So, what I'd really like is to add some code for:

all three data tabs to be filtered by name
highlight only the first 6 tabs to be saved as PDF, add page numbers
start process again for the next name (all in column B). I don't need excel files saved out this is just what I could find out there.

Create & Save filtered lists into PDF

Participate now!

Share

Tags