Save all versions of data validation to one PDF

Whitmore

New Member
Joined
Mar 20, 2023
Messages
2
Platform
  1. Windows
I have a worksheet named 'RAG' that creates individual sheets for each student.

currently I have the code below that prints each validation. However, I'm looking at a way to have option to save it as one PDF document.
I will want to be able to choose file path and name at point of save.

Any brilliant minds out there that can help?

for information - the validation list length changes depending on how many names are entered on a number page.

Sub Print_all()
Dim xRg As Range
Dim xCell As Range
Dim xRgVList As Range
Set xRg = Worksheets("RAG").Range("C2")
Set xRgVList = Evaluate(xRg.Validation.Formula1)
For Each xCell In xRgVList
xRg = xCell.Value
ActiveSheet.PrintOut

Next
End Sub

1679335605759.png
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
I have a worksheet named 'RAG' that creates individual sheets for each student.

currently I have the code below that prints each validation. However, I'm looking at a way to have option to save it as one PDF document.
I will want to be able to choose file path and name at point of save.
Try this macro:

VBA Code:
Public Sub Create_Multiple_Pages_PDF()

    Dim PDFfullName As Variant
    Dim PDFsheet As Worksheet, destCell As Range
    Dim dataValidationCell As Range, dataValidationListSource As Range, dvValueCell As Range
    
    PDFfullName = Application.GetSaveAsFilename(InitialFileName:=ThisWorkbook.Path, _
                                                FileFilter:="PDF (*.pdf), *.pdf", _
                                                Title:="Save as PDF")
    If PDFfullName = False Then Exit Sub
    
    'Add temporary sheet for PDF output
    
    With ActiveWorkbook
        Set PDFsheet = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
    End With
    Set destCell = PDFsheet.Range("A1")
    
    'Cell containing data validation in-cell dropdown

    Set dataValidationCell = ActiveWorkbook.Worksheets("RAG").Range("C2")
     
    'Source of data validation list
    
    Set dataValidationListSource = Evaluate(dataValidationCell.Validation.Formula1)
     
    'Set each value in the data validation cell
    
    For Each dvValueCell In dataValidationListSource
    
        dataValidationCell.Value = dvValueCell.Value
        
        'Copy sheet cells to next cell in temporary PDF sheet
        
        dataValidationCell.Worksheet.UsedRange.Copy
        destCell.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        destCell.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        destCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
        'Add page break and update destination cell
        
        With PDFsheet
            .HPageBreaks.Add Before:=.Rows(.UsedRange.Rows.Count + 1)
            Set destCell = .Cells(.UsedRange.Rows.Count + 1, 1)
        End With
    
    Next
    
    'Save temporary sheet as .pdf file
    
    PDFsheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfullName, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    
    'Delete temporary sheet
    
    Application.DisplayAlerts = False
    PDFsheet.Delete
    Application.DisplayAlerts = True
    
End Sub
 
Upvote 0
Thank you for your reply, I'm now one step closer.

this line of code I had to remove as it was failing to complete the action due to merged cells.
VBA Code:
 destCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

It's almost perfect, but it's not using the set print area, meaning it's spread across a number of sheets, where I need one sheet per validation / print area
 
Upvote 0
This revised macro should handle merged cells and it copies the print area to the PDF instead of the used range. It also copies cell formats, pictures, column widths and row heights.

VBA Code:
Public Sub Create_Multiple_Pages_PDF2()

    Dim PDFfullName As Variant
    Dim PDFsheet As Worksheet, destCell As Range
    Dim dataValidationCell As Range, dataValidationListSource As Range, dvValueCell As Range
    Dim copyRange As Range
    
    PDFfullName = Application.GetSaveAsFilename(InitialFileName:=ThisWorkbook.Path, _
                                                FileFilter:="PDF (*.pdf), *.pdf", _
                                                Title:="Save as PDF")
    If PDFfullName = False Then Exit Sub
    
    Application.ScreenUpdating = False
    
    'Add temporary sheet for PDF output
    
    With ActiveWorkbook
        Set PDFsheet = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
    End With
    Set destCell = Nothing
    
    'Cell containing data validation in-cell dropdown

    Set dataValidationCell = ActiveWorkbook.Worksheets("RAG").Range("C2")
     
    'Source of data validation list
    
    Set dataValidationListSource = Evaluate(dataValidationCell.Validation.Formula1)
     
    'Set each value in the data validation cell
    
    For Each dvValueCell In dataValidationListSource
    
        'The print area will be copied
        
        dataValidationCell.Value = dvValueCell.Value
        Set copyRange = dataValidationCell.Worksheet.Range(dataValidationCell.Worksheet.PageSetup.PrintArea)
        
        If destCell Is Nothing Then Set destCell = PDFsheet.Range(copyRange.Address)
            
        'Copy cells to destination cell in temporary PDF sheet
    
        copyRange.Copy
        
        With destCell
            .Select
            'Paste cells including formats, merged cells and pictures
            .Worksheet.Paste
            'Apply column widths
            .PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            'Change cells to values
            .Resize(copyRange.Rows.Count, copyRange.Columns.Count).Value = copyRange.Value
            'Use Format Painter to copy and paste row heights
            copyRange.EntireRow.Copy
            .Resize(copyRange.Rows.Count).EntireRow.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End With
        
        'Add page break and update destination cell
        
        With PDFsheet
            Set destCell = destCell.Offset(copyRange.Rows.Count)
            .HPageBreaks.Add Before:=destCell
        End With
    
    Next
    
    'Save temporary sheet as .pdf file
    
    PDFsheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfullName, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    
    'Delete temporary sheet
    
    Application.DisplayAlerts = False
    PDFsheet.Delete
    Application.DisplayAlerts = True
    
    Application.ScreenUpdating = True
    
End Sub
 
Upvote 0
This revised macro should handle merged cells and it copies the print area to the PDF instead of the used range. It also copies cell formats, pictures, column widths and row heights.

VBA Code:
Public Sub Create_Multiple_Pages_PDF2()

    Dim PDFfullName As Variant
    Dim PDFsheet As Worksheet, destCell As Range
    Dim dataValidationCell As Range, dataValidationListSource As Range, dvValueCell As Range
    Dim copyRange As Range
   
    PDFfullName = Application.GetSaveAsFilename(InitialFileName:=ThisWorkbook.Path, _
                                                FileFilter:="PDF (*.pdf), *.pdf", _
                                                Title:="Save as PDF")
    If PDFfullName = False Then Exit Sub
   
    Application.ScreenUpdating = False
   
    'Add temporary sheet for PDF output
   
    With ActiveWorkbook
        Set PDFsheet = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
    End With
    Set destCell = Nothing
   
    'Cell containing data validation in-cell dropdown

    Set dataValidationCell = ActiveWorkbook.Worksheets("RAG").Range("C2")
    
    'Source of data validation list
   
    Set dataValidationListSource = Evaluate(dataValidationCell.Validation.Formula1)
    
    'Set each value in the data validation cell
   
    For Each dvValueCell In dataValidationListSource
   
        'The print area will be copied
       
        dataValidationCell.Value = dvValueCell.Value
        Set copyRange = dataValidationCell.Worksheet.Range(dataValidationCell.Worksheet.PageSetup.PrintArea)
       
        If destCell Is Nothing Then Set destCell = PDFsheet.Range(copyRange.Address)
           
        'Copy cells to destination cell in temporary PDF sheet
   
        copyRange.Copy
       
        With destCell
            .Select
            'Paste cells including formats, merged cells and pictures
            .Worksheet.Paste
            'Apply column widths
            .PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            'Change cells to values
            .Resize(copyRange.Rows.Count, copyRange.Columns.Count).Value = copyRange.Value
            'Use Format Painter to copy and paste row heights
            copyRange.EntireRow.Copy
            .Resize(copyRange.Rows.Count).EntireRow.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End With
       
        'Add page break and update destination cell
       
        With PDFsheet
            Set destCell = destCell.Offset(copyRange.Rows.Count)
            .HPageBreaks.Add Before:=destCell
        End With
   
    Next
   
    'Save temporary sheet as .pdf file
   
    PDFsheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfullName, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
   
    'Delete temporary sheet
   
    Application.DisplayAlerts = False
    PDFsheet.Delete
    Application.DisplayAlerts = True
   
    Application.ScreenUpdating = True
   
End Sub

Hello! I'm attempting to use this code and it seems to be working ok, but it's not staying within the Print Area. Any other suggestions as to why it might off.

Thank you for your help.
 
Upvote 0
I'm attempting to use this code and it seems to be working ok, but it's not staying within the Print Area.

Replace:

VBA Code:
        'Add page break and update destination cell
        
        With PDFsheet
            Set destCell = destCell.Offset(copyRange.Rows.Count)
            .HPageBreaks.Add Before:=destCell
        End With
with:

VBA Code:
        'Set or extend print area of temporary PDF sheet, add page break and update destination cell
        
    Dim printRange As Range

        With PDFsheet
            If .PageSetup.PrintArea = "" Then
                .PageSetup.PrintArea = copyRange.Address
            Else
                Set printRange = Range(.PageSetup.PrintArea)
                Set printRange = printRange.Resize(printRange.Rows.Count + copyRange.Rows.Count)
                .PageSetup.PrintArea = printRange.Address
            End If
            Set destCell = destCell.Offset(copyRange.Rows.Count)
            .HPageBreaks.Add Before:=destCell
        End With
The new code sets the print area on the temporary PDF sheet to the same as the data range, extending it for each data validation value.
 
Upvote 0

Forum statistics

Threads
1,223,879
Messages
6,175,147
Members
452,615
Latest member
bogeys2birdies

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top