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

[SMRXIV]

Hi All,

I need some help with building a Macro, I want to create a VBA code which changes one cell on a sheet, save the active print area in the sheet as PDF, then loop back and change that one cell on that sheet and repeat. I want the cell to change between integers of 1000 to 1100. I also want the naming of the PDFs linked to a certain cell so it can be flexible but also want to include some additional text to the file name that isnt flexible.

I am completely useless with VBA so asked chatgpt to help out and after a few iterations it spat this out which still doesn't work the way I wanted so wanted to come here to get some assistance if possible.

Thanks a lot in advance!

+++

Sub SavePrintAreaAsPDF()
2 Dim ws As Worksheet
3 Dim printArea As Range
4 Dim filePath As String
5 Dim fileNamePrefix As String
6 Dim counter As Integer
7
8 ' Set the worksheet to work with
9 Set ws = ThisWorkbook.Worksheets("Sheet1") ' Replace "Sheet1" with your sheet name
10
11 ' Set the file path to save the PDFs
12 filePath = "FilePath" ' Replace with your desired file path
13
14 ' Set the prefix for the file name (additional text)
15 fileNamePrefix = "Prefix_" ' Replace with your desired prefix
16
17 ' Loop through the integers from 1000 to 1100
18 For counter = 1000 To 1100
19 ' Change the value of the specified cell
20 ws.Range("c1").Value = counter ' Replace "C1" with the cell you want to change
21
22 ' Determine the print area using the UsedRange
23 Set printArea = ws.UsedRange
24
25 ' Check if a print area is set
26 If Not printArea Is Nothing Then
27 ' Get the file name from a certain cell
28 Dim fileName As String
29 fileName = fileNamePrefix & ws.Range("B1").Value ' Replace "B1" with the cell containing the flexible part of the file name
30
31 ' Save the print area as PDF
32 printArea.ExportAsFixedFormat Type:=xlTypePDF, fileName:=filePath & fileName & ".pdf", Quality:=xlQualityStandard
33 Else
34 MsgBox "No print area is set."
35 End If
36 Next counter
37 End Sub


Please also let me know if you need more information to assist

 

[sxhall]

Hi SMRXIV,

I've had a play about with the code you got from chatGPT (!) and made a few changes.

The updates I've added will allow you to choose the folder using the same method as if you were to click on 'Save As' with the Excel dialog popup.

When this comes up select the folder and click OK, it will then save a PDF for each count between 1000 and 1100. I've set to only run to 1003 in my cade as a test so I don't have to delete a thousand PDFs each time

Sub SavePrintAreaAsPDF()

Dim ws As Worksheet
Dim PrintArea As Range
Dim FilePath As String
Dim Counter As Integer
Dim FlexiText As String 'This will be what is on the worksheet
Dim UnFlexiText As String 'This will be determined by you in the code below

'************************************************************************************
'The code in this section allows you to choose the folder you want the files saved to.

With Application.FileDialog(msoFileDialogFolderPicker)

    .Title = "Select A Folder To Save PDFs In..."
    .AllowMultiSelect = False

        If .Show <> -1 Then Exit Sub
        FilePath = .SelectedItems(1) & "\"

End With
'************************************************************************************

'************************************************************************************
'Code from here on will name the file, change the value on the sheet and save a file
'for the count of 1000 to 1100

Set ws = ThisWorkbook.ActiveSheet

FlexiText = Range("A1").Value 'change this cell to the cell with your file name prefix
UnFlexiText = "Defined by You"

For Counter = 1000 To 1003 'Change the 1003 here once tested to 1100 :-)

    ActiveSheet.Range("A2").Value = Counter 'change this cell to where the counter will value will go
    
    Set PrintArea = ActiveSheet.UsedRange
    
    If Not PrintArea Is Nothing Then
    
    Dim fileName As String
    fileName = UnFlexiText & " " & FlexiText & " " & Counter 'Swap Unflexi and Flexi here to determine what you want the file name to look like
    
    PrintArea.ExportAsFixedFormat Type:=xlTypePDF, fileName:=FilePath & fileName & ".pdf", Quality:=xlQualityStandard
    
    Else
    
    MsgBox "No print area is set."
    
    End If

Next Counter

'************************************************************************************

End Sub

This is my test sheet showing the cells I used for the name 'A1' and the counter 'A2'

This is how it looks in the folder I chose to save them into...

 

[jolivanes]

Change references as required
Range("I1") has the numbering from 1000 to 1100
Cells(1) = A1 has the "naming of the PDFs"
Cells(1, 5) = E1 has the additional text.
PDF files are saved in the same folder as this workbook.

Sub Maybe()
Dim i As Long
Dim sh2 As Worksheet
Set sh2 = Worksheets("Sheet2")    '<---- Sheet name of the sheet to be saved as PDF
sh2.PageSetup.PrintArea = "A1:I42"    '<---- If you want to hardcode the print area
For i = 1000 To 1010    '<---- Change to required values
    With sh2
        .Range("I1").Value = i    '<---- Your "one cell changes" with values from 1000 to 1100
        .ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & sh2.Cells(1).Value & " " & sh2.Cells(1, 9).Value & " " & sh2.Cells(1, 5).Value & ".pdf"
    End With
Next i
End Sub

 

[IslandofBDA]

hello

i was following this post and I believe this thread is close to what I would like to do

create a macro that will save a pdf in a folder

with each pdf the name of each the cell value

[ the list of cells could 25 up to 100 }

please help