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

New Member
Joined
Nov 2, 2020
Messages
2
Office Version
  1. 365
Platform
  1. Windows
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.
 

Some videos you may like

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

cooper645

Well-known Member
Joined
Nov 16, 2013
Messages
622
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
  3. Mobile
  4. Web
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:

VBA Code:
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

Well-known Member
Joined
Nov 16, 2013
Messages
622
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
  3. Mobile
  4. Web
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

VBA Code:
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

New Member
Joined
Nov 2, 2020
Messages
2
Office Version
  1. 365
Platform
  1. Windows
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

Well-known Member
Joined
Nov 16, 2013
Messages
622
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
  3. Mobile
  4. Web
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.

VBA Code:
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

New Member
Joined
Nov 6, 2020
Messages
4
Office Version
  1. 365
Platform
  1. Windows
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:


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.
 

Watch MrExcel Video

Forum statistics

Threads
1,126,957
Messages
5,621,822
Members
415,859
Latest member
Vain

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
Top