Macro to change one cell on a sheet, save sheet as PDF, then loop back and change that one cell on that sheet and repeat until the end

[MFlynn44]

Hi all

I am in the process of creating performance reports. I am looking to save multiple PDF documents from one sheet however I need one cell to change before each saves to PDF.

Excel Document Overview

• Sheet 1 = Report Template (A1:K34)
• Sheet 2 = List of Employee's names (B2:B151)
• Sheet 3 = Data sheet which feeds the data into the report template

Is it possible for the following steps to be completed using VBA?

1. In "Sheet 1", select cell "B2" and link first name of the list (B2) in "Sheet 2" (This will pull in that employees data into the report template)
2. Save "Sheet 1" as a pdf and name the document as the employee's name
3. In "Sheet 1", select cell "B2" and link the second name of the list (B3) in "Sheet 2"
4. Save "Sheet 1" as a pdf and name the document as the employee's name

Repeat/loop this until the list of names in "Sheet 2" has been complete?

Any help would be greatly appreciated

 

[rpaulson]

try this; adjust the output path as needed.

Sub Create_PDF()

Application.ScreenUpdating = False

Dim rs1 As Worksheet, rs2 As Worksheet

Set rs1 = Worksheets("Sheet1")
Set rs2 = Worksheets("Sheet2")

myPath = "C:\results\"

For r = 2 To 151

empName = rs2.Cells(r, "B")
rs1.[B2] = empName

Set Rng = rs1.Range("A1:K34")
Rng.ExportAsFixedFormat Type:=xlTypePDF, FileName:=myPath & empName & ".pdf"

Next r
 
Application.ScreenUpdating = False

End Sub

hth,
ROss

 

[MFlynn44]

try this; adjust the output path as needed.

Sub Create_PDF()

Application.ScreenUpdating = False

Dim rs1 As Worksheet, rs2 As Worksheet

Set rs1 = Worksheets("Sheet1")
Set rs2 = Worksheets("Sheet2")

myPath = "C:\results\"

For r = 2 To 151

empName = rs2.Cells(r, "B")
rs1.[B2] = empName

Set Rng = rs1.Range("A1:K34")
Rng.ExportAsFixedFormat Type:=xlTypePDF, FileName:=myPath & empName & ".pdf"

Next r

Application.ScreenUpdating = False

End Sub

hth,
ROss

Hi Ross,

Thanks for responding. When I clicked "Continue" it said "Script out of Range" and highlighted the below section.

Set rs1 = Worksheets("Sheet1")
Set rs2 = Worksheets("Sheet2")

Do I need to make an adjustment to this?

I've updated the path as you suggested.

Thanks again, Mark

 

[rpaulson]

Set rs1 = Worksheets("Sheet1") - Change "Sheet1" to the name of you actual PDF sheet . example: Set rs1 = Worksheets("Report Template")

Set rs2 = Worksheets("Sheet2") - Change "Sheet2" to the name of you actual Employee List sheet. example: Set rs2 = Worksheets("Employee List")

 

[MFlynn44]

Hi Ross,

Thats excellent it worked perfectly.

Much appreciated!

 

[bjoshi5603]

Try This:
Sub Saveaspdf()

On Error GoTo getout

'This macro was created by Bhaskar joshi as on 18 Mar 2021

Dim Bhaskar As Integer, YodaLearning As String, ExcelSuperstar As Integer

Bhaskar = InputBox("Please Enter Minimum Invoice No.", "Enter only Digit")
ExcelSuperstar = InputBox("Please Enter Maximum NO. of Invoice", "Enter only Digit") + 1

Do While Bhaskar < ExcelSuperstar

Range("A1").Value = Bhaskar 'Inside Pdf values changes based of Cell A1
YodaLearning = Range("A5").Value 'make combination of folder path here based of (=A4&"\"&SUBSTITUTE(E17&" "&J6&" _"&TEXT(TODAY(),"DDMMYY"),"/","_")&".pdf") which will give result like this D:\Invoices\Final DG Invoices\M_s HXXXXXXy DG_FY22_3R_20 080521.pdf
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=YodaLearning, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
getout:

Bhaskar = Bhaskar + 1
Loop

End Sub

 

[rstlhiii]

Hi all

I am in the process of creating performance reports. I am looking to save multiple PDF documents from one sheet however I need one cell to change before each saves to PDF.

Excel Document Overview

• Sheet 1 = Report Template (A1:K34)
• Sheet 2 = List of Employee's names (B2:B151)
• Sheet 3 = Data sheet which feeds the data into the report template

Is it possible for the following steps to be completed using VBA?

1. In "Sheet 1", select cell "B2" and link first name of the list (B2) in "Sheet 2" (This will pull in that employees data into the report template)
2. Save "Sheet 1" as a pdf and name the document as the employee's name
3. In "Sheet 1", select cell "B2" and link the second name of the list (B3) in "Sheet 2"
4. Save "Sheet 1" as a pdf and name the document as the employee's name

Repeat/loop this until the list of names in "Sheet 2" has been complete?

Any help would be greatly appreciated

I had a similar problem and ended up combining a couple Macros that I had to get the results I wanted. The below Macro will cycle through a dropbox, and save the file based on cell values in A1, A2, A3. The green text is where you identify the location of the dropdown, dropdown names, and the sheet you want to print.

Sub PrintfromDVList()



Dim ws As Worksheet

Dim i As Long

Dim wsA As Worksheet

Dim wbA As Workbook

Dim strName As String

Dim strPath As String

Dim strFile As String

Dim strPathFile As String

Dim myFile As Variant

'On Error GoTo errHandler



Set wbA = ActiveWorkbook

Set wsA = ActiveSheet



[COLOR=rgb(97, 189, 109)]Set ws = Sheets("Data") 'set as page with names



For i = 6 To ws.Cells(Rows.Count, "A").End(xlUp).Row 'location of names

With Sheets("Graph") 'set as page to print

.Range("A1").Value = ws.Cells(i, "A").Value 'location of drop down on printable sheet[/COLOR]



'get active workbook folder, if saved

strPath = wbA.Path

If strPath = "" Then

strPath = Application.DefaultFilePath

End If

strPath = strPath & "\"



strName = wsA.Range("A1").Value _

& " - " & wsA.Range("A2").Value _

& " - " & wsA.Range("A3").Value



'create default name for savng file

strFile = strName & ".pdf"

strPathFile = strPath & strFile



'export to PDF in current folder

wsA.ExportAsFixedFormat _

Type:=xlTypePDF, _

Filename:=strPathFile, _

Quality:=xlQualityStandard, _

IncludeDocProperties:=True, _

IgnorePrintAreas:=False, _

OpenAfterPublish:=False

'confirmation message with file info

' MsgBox "PDF file has been created: " _

' & vbCrLf _

' & strPathFile



'.PrintPreview 'Change to PrintOut after testing

'.PrintOut

End With

Next i



End Sub