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

[RoryRBS]

Hi All

I am looking to print/save multiple PDF documents on one sheet however I need one variable to change before it saves/prints to PDF. Currently I have the following macro which "works" however it requires me to type in a file name, choose a file path and then click save on each and every print:
Sub DateToForm()

Dim MyRange As Range, MyVal As Range, LR As Long

LR = Sheets("Client statements").Range("A" & Rows.Count).End(xlUp).Row

Set MyRange = Sheets("Client statements").Range("A5:A" & LR)

For Each MyVal In MyRange

Sheets("Statements").[A10].Value = MyVal.Value

Sheets("Statements").PrintOut Copies:=1

Next MyVal

Sheets("Statements").[A10].Value = ""

End Sub

Could someone help me add to the macro so that it:
- Fills in the file name from a specific cell on the Sheets("Statements")
- Save all PDF so a file path located on Sheets("Statements") in cell i2
- perform this without having to click save/print each time it loops

Thank you in advance to anyone that helps.

 

[cooper645]

I'll have a bash with another version guessing at a couple of points like the save name each time etc, but for now something like below:

Sub DateToForm()
Application.ScreenUpdating = False
On Error GoTo Err
Dim i As Double, svNm As String, fPath As String
Dim MyRange As Range, MyVal As Range, LR As Long

LR = Sheets("Client statements").Range("A" & Rows.Count).End(xlUp).Row

svNm = Sheets("Statements").Range("A1") & ".pdf" 'Move into the loop if you need it to loop through different names !!

fPath = Sheets("Statements").Range("I2").Value

Set MyRange = Sheets("Client statements").Range("A5:A" & LR)

For Each MyVal In MyRange

Sheets("Statements").[A10].Value = MyVal.Value

Sheets("Statements").PrintOut Copies:=1

            'Save PDF
            Application.PrintCommunication = True
            ChDir fPath
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=fPath & svNm, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Next MyVal

Sheets("Statements").[A10].Value = ""
           

           
Err:
Application.ScreenUpdating = True
End Sub

 

[cooper645]

This is how I would do it,
- Gets last row from client statements
- Gets the FilePath from Statements cell I2 (Fixed)
- Loops through Client Statements A5 to A & LastRow
+ Setting Statements cell A10 value to Client Statements A and I where I is each row from 5 to last row
+ Prints the Statements Sheet
+ Sets the Save Name string to A10 value & pdf
+ Saves to pdf without opening it
- Next loop through

Clear the value from Statements A10

Sub DateToForm2()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

On Error GoTo Err

Dim i As Long, svNm As String, fPath As String
Dim Sh As Worksheet, ShCS As Worksheet
Dim MyRange As Range, MyVal As Range, LR As Long

Set Sh = Sheets("Statements")
Set ShCS = Sheets("Client statements")

LR = ShCS.Range("A" & Rows.Count).End(xlUp).Row

fPath = Sheets("Statements").Range("I2").Value

For i = 5 To LR
    Sh.Cells(10, 1) = ShCS.Cells(i, 1)
        Sh.PrintOut
            svNm = Sh.Cells(10, 1) & ".pdf"
                'Save PDF
                    Application.PrintCommunication = True
                    ChDir fPath
                    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=fPath & svNm, _
                    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next i

Sh.Cells(10, 1).ClearContents
            
Err:
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

 

[RoryRBS]

Hi Cooper645

Thank you for the above (it is really helping me)! The first code you sent work but I still had to add the file name and I think it is because the template that is using got changed this morning. The new cells are as follows:

- Takes the data from A5 (range is A5 until infinity or until there are no more entries) on Sheets("Client statements") and fills the data into cell B18 on Sheets("Statements") (before it prints)
- Save all PDF so a file path located on Sheets("Statements") in cell i5
- Saves the PDFs filename by taking the value in Sheets("Statements") in cell i2
- perform this without having to click save/print each time it loops through the range cell A5 on Sheets("Client statements") until there are no more entries (so each time the loop occurs it will change cell B18 on Sheets("Statements") from the next cell starting from A5 on Sheets("Client statements").

Thanks again!

 

[cooper645]

I have re written the code to suit new ranges and added comments to assist understanding the code should it need any amending. Still happy to do it for you if it needs it.

Sub DateToForm3()

Application.ScreenUpdating = False 'Speed up macro
Application.DisplayAlerts = False 'Speed up macro

On Error GoTo Err 'If an error occurs goto the Err handling at bottom of code

Dim i As Long, svNm As String, fPath As String
Dim Sh As Worksheet, ShCS As Worksheet
Dim MyRange As Range, MyVal As Range, LR As Long

Set Sh = Sheets("Statements")
Set ShCS = Sheets("Client statements")

LR = ShCS.Range("A" & Rows.Count).End(xlUp).Row 'Get the last row number of data from Client Statements column A

fPath = Sheets("Statements").Range("I5").Value 'Get the filepath from Statements Cell I5

For i = 5 To LR 'Loop through 5 to last row number
    Sh.Cells(18, 2) = ShCS.Cells(i, 1) 'Set Statements B18 to the loop value fromClient statments A5 - LR
        Sh.PrintOut 'Print statements sheet
            svNm = Sh.Cells(9, 2) & ".pdf" 'Set the save nameto value of Statments cell I2 (Assuming this is a formula that changes based on another cell, else save name will never change)
                'Save PDF
                    Application.PrintCommunication = True
                    ChDir fPath
                    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=fPath & svNm, _
                    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next i 'go back and do next row in loop

Sh.Cells(18, 2).ClearContents 'Clear Statements B18 cell contents
           
Err: 'Error handling and end of code to turnscreen updating and display events back on
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

 

[taylrmstrng]

hey mate
I have a macro that does essentially this, it's running a bit slow so I've queried here but you can see my code here:

VBA to update page, save as PDF and repeat is super slow!

I have a macro that essentially does the following: moves a list of client names up one cell. all the calculations on the table (including arrays) are recalculated based on the new value in cell O2 unhides all hidden rows hides all rows with 0 values saves as PDF with the name of a cell...

www.mrexcel.com

The way mine loops is it copies a list of values to cell O2, and keeps repeating, eventually there will be a duplicate cell (the last value in the list that keeps getting copied) so it stops once O2 = O3.
Note I did the looper separate to the actual macro.

 

[blairski10]

I have re written the code to suit new ranges and added comments to assist understanding the code should it need any amending. Still happy to do it for you if it needs it.

Sub DateToForm3()

Application.ScreenUpdating = False 'Speed up macro
Application.DisplayAlerts = False 'Speed up macro

On Error GoTo Err 'If an error occurs goto the Err handling at bottom of code

Dim i As Long, svNm As String, fPath As String
Dim Sh As Worksheet, ShCS As Worksheet
Dim MyRange As Range, MyVal As Range, LR As Long

Set Sh = Sheets("Statements")
Set ShCS = Sheets("Client statements")

LR = ShCS.Range("A" & Rows.Count).End(xlUp).Row 'Get the last row number of data from Client Statements column A

fPath = Sheets("Statements").Range("I5").Value 'Get the filepath from Statements Cell I5

For i = 5 To LR 'Loop through 5 to last row number
    Sh.Cells(18, 2) = ShCS.Cells(i, 1) 'Set Statements B18 to the loop value fromClient statments A5 - LR
        Sh.PrintOut 'Print statements sheet
            svNm = Sh.Cells(9, 2) & ".pdf" 'Set the save nameto value of Statments cell I2 (Assuming this is a formula that changes based on another cell, else save name will never change)
                'Save PDF
                    Application.PrintCommunication = True
                    ChDir fPath
                    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=fPath & svNm, _
                    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next i 'go back and do next row in loop

Sh.Cells(18, 2).ClearContents 'Clear Statements B18 cell contents
          
Err: 'Error handling and end of code to turnscreen updating and display events back on
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

I've used adopted this code for my own purposes, but it stops half way through my list. I want it to do the following:

1. Populate the Rate Model based on values 1-113 which can be entered into Cell D2 on Sheet("Rate Makeup").
2. Print to PDF Sheet("Rate Makeup")
3. Save the File to C:\PDF Print\22-23 Rate Model\Rate Makeup with a name derived from Cell B7 on Sheet("Rate Makeup").

However, it's only getting to about #60 on my list and then stopping. Is this an error in my code or something else?

 

[cooper645]

I've used adopted this code for my own purposes, but it stops half way through my list. I want it to do the following:

1. Populate the Rate Model based on values 1-113 which can be entered into Cell D2 on Sheet("Rate Makeup").
2. Print to PDF Sheet("Rate Makeup")
3. Save the File to C:\PDF Print\22-23 Rate Model\Rate Makeup with a name derived from Cell B7 on Sheet("Rate Makeup").

However, it's only getting to about #60 on my list and then stopping. Is this an error in my code or something else?

It would be helpful if you posted your code. It makes life debugging it difficult when all I can do is guess at how you have adapted it.

 

[blairski10]

It would be helpful if you posted your code. It makes life debugging it difficult when all I can do is guess at how you have adapted it.

So I ended up going with some older, but simpler code that I had from a previous model. However, it's only going to Value 60 when I do the loop, but I want it to go to the last row in a defined range. See below for the code:

Sub Save2PDF()

For i = 11 To Range("k" & Rows.Count).End(xlUp).Row
'Cell k2 in Sheet 1 is the cell that has the value that drives the printable range and needs to update through a list of values in K11:K123
Sheet1.[k2] = Range("k" & i).Value 'This is where it breaks and only goes to 60
Application.Calculate
Sheets("Rate Makeup").Select
ActiveSheet.ExportAsFixedFormat xlTypePDF, Filename:="C:\PDF Print\22-23 Rate Model\Rate Makeup" & Sheet1.[b7].Value & ".pdf"
Next i
End Sub


Any ideas as to why it's stopping at 60 or if there's a better way to do this? Thanks for your response!