Save defined range as pdf where I choose the subfolder to place the file

[sspatriots]

I thought I was done for today and then came across this issue with another macro I'm trying to make work. I want to print a defined range on my currently Active Worksheet to a ".pdf" file so that the range fits all on one page. I need it to take me to a defined file path that has many folders beneath it that I need to choose from to save it under.

For example:

H:\PO Block History\ is the parent folder that has about 10 subfolders beneath it with the name of a year.

H:\PO Block History\2013
H:\PO Block History\2014
H:\PO Block History\2015
H:\PO Block History\2016
H:\PO Block History\2017
H:\PO Block History\2018
H:\PO Block History\2019
H:\PO Block History\2020
H:\PO Block History\2021
H:\PO Block History\2022

When the code gets to the point where I need to select one of these folders to put it in I need to be able to choose where it goes. I need the ".pdf" file name to come from the values in cells K6, L6 & D20 (with a space between L6 & D20).

So the file name may look like "2022-999 123 Bachelor Quarters"
Where,
K6 = 2022
L6 = -999
D20 = 123 Bachelor Quarters

The defined range is B1:L60


Below is what I have found to start with...


Sub SaveRangeAsPDF()

'Create and assign variables
Dim saveLocation As String
Dim rng As Range
Dim ws As Worksheet

Set ws = ActiveSheet
saveLocation = "H:\PO Block History\"
Set rng = ActiveSheet.Range("B1:L60")

'Save a range as PDF
rng.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=saveLocation

End Sub

 

[sspatriots]

What's up with the repetitive quoting & pic posting but no related commentary?
I understand new stuff is difficult for novices but IMO we should be progressing much better than we are. Here's what you must do if I'm to continue attempting to arrive at a solution:
1) enclose your code in code tags (click vba button on posting toolbar & paste in between the tags. Use proper indentation. See how much easier it is to read in post 7.
2) I need to know exactly what ranges your code needs to reference and what's in those cells. So far we've got cells in D, K, L and maybe more.
3) I need to know the starting folder path or at least where you're getting it from. I gather that is D1 and D3.

Describe what has to happen and when. Example based on what I think I know at this point:

1) When I click the button I want the dialog to open at the path stored in D1. I will choose a folder and click OK.
2) Then I want the range to be stored in that folder as a pdf.
3) I also want the same pdf to be stored in a folder whose complete path is stored in D3.

or is it 1) and 2) then
3) I want the fd to open again at the starting path that's stored in D3 and I will choose the folder to store the 2nd pdf in.
Or maybe something else?

All that might seem like a lot of work but I think you've already done more than that without achieving your goal.

I tried deleting, but it would not let me do it after I realized it was on there more than once. Tried uploading a sample and it wouldn't let me do it. I need to delete that image from my last post and not sure how because I couldn't edit after 10 minutes. I'll get back to this later. Right now, I'm working my second job and not supposed to be doing this when working here. My apologies for the multiple replies. Something was hanging up and before I knew it there they were. If you know how I can remove them, I will. Thanks SS

 

[Micron]

No worries. You only have 10 minutes to edit as you discovered, which is why I always check my post after saving. Not worth asking admin to remove, I'd say.
You can't upload here AFAIK but you can use xl2BB or just paste copied cells. Now back to work!

 

[sspatriots]

Well, this is where I landed with this one. The first macro "PDFActiveSheet" worked to have my user be able to start in the same folder that the source file is in to save their PDF. The second macro "PDFActiveSheetPOARCHIVE' allowed me to set a different start path to save my PDF file from. The only other thing I wanted to do and couldn't figure out was to prompt me if the file already existed in that folder so it couldn't be overwritten.. To get around it, I added the date stamp. Not what I wanted, but it works for now. If anyone can show me how to get that warning that you are about to overwrite the file, I'd like to see it. It won't actually overwrite it, it just does nothing and making you think it saved the file there. The original source of this code came from the website in the code.


Option Explicit

Sub PDFActiveSheet()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
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
strTime = Format(Now(), "yyyymmdd\_hhmm")

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"


strName = wsA.Range("K6").Value _
& " " & wsA.Range("D20").Value


'create default name for savng file
strFile = strName & " " & strTime & ".pdf"
strPathFile = strPath & strFile


'user can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If

exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
*************************************************************************************************************************************************************************************
Sub PDFActiveSheetPOARCHIVE()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim lOver As Long
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")


'get active workbook folder, if saved
strPath = "G:\Automobiles\Trucks"
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"



strName = wsA.Range("K6").Value _
& " " & wsA.Range("D20").Value


'create default name for savng file
strFile = strName & " " & strTime & ".pdf"
strPathFile = strPath & strFile


'user can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If

exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub

 

[Micron]

1) enclose your code in code tags (click vba button on posting toolbar & paste in between the tags. Use proper indentation. See how much easier it is to read in post 7.

Sorry, but if you can't follow through with requests I can no longer help you. I'm not going to try to read that code. Besides, your code seems to be vastly different from one post to another - too hard to keep up.
Wish you luck with it.

 

[sspatriots]

Sorry, but if you can't follow through with requests I can no longer help you. I'm not going to try to read that code. Besides, your code seems to be vastly different from one post to another - too hard to keep up.
Wish you luck with it.

Sorry, I didn't notice you had sent me something else to try. I saw one post with something that had i = 2 To 3. However, I tried putting that in the one macro I had and I had no idea what I was doing. I typically just end up piecing things together until I get something to work, that's why I had different versions I found and tried. I've never had any training in VBA except what I pick up as I go along.

 

[Micron]

OK, then if you follow through on what was requested in that post, I'll keep trying.

 

[sspatriots]

OK, then if you follow through on what was requested in that post, I'll keep trying.

Looking at my post #11 (because that one seems to work the best):

1. This code in my post #11 will not recognize whether or not you have already put the PDF file in that folder. There are no error messages. It just runs through and gives a pop up window saying that you created the PDF and where it was placed. So for example, if I have already created the PDF in the same folder and it was put there yesterday, it makes me believe that it just put the file there for the first time. When in fact I go back and look at the file in the folder, the only file in there is the file from the day before. Basically it didn't do anything when there was a file with that same name already in that folder.

2. There is really nothing to tag in the code on my post #11 because that code actually works, just doesn't do everything I would like it to do. As a Band-Aid, I slipped the date/time stamp in the file name so that it would save a PDF where I wanted it every time. They have the same name, but only difference is at the end of the file name where it places the date/time stamp. I'm not really clear on what code tags are. Is that highlighting parts of code where it hangs up?

3. Ideally, I wanted this code to recognize that the PDF file had already been saved in the folder I'm trying to put it in and let me know so that I can add a revision to the end of the new file name like stick "R1" or "R2" at the end of the file names number portion. So if the file "2022-1000 123 John Doe Ave.pdf" already exist, then I'd like to tack "R1" on the end of the number portion and have both the files in that folder, i.e. "2022-1000 R1 123 John Doe Ave.pdf". Basically, I'd like to see the warning box that the file already exist, would I like to overwrite it, if I select "Yes" then I replace it. If I select "No", then it gives me the chance to insert the slight change to the file name myself.

This is the best I can describe what is going on. Let me know if this makes any sense or not. Thanks, SS

 

[sspatriots]

Not sure if I did that right or not.

Option Explicit

Sub PDFActiveSheet()
'[URL='http://www.contextures.com/']www.contextures.com[/URL]
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
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
strTime = Format(Now(), "yyyymmdd\_hhmm")

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"


strName = wsA.Range("K6").Value _
& " " & wsA.Range("D20").Value


'create default name for savng file
strFile = strName & " " & strTime & ".pdf"
strPathFile = strPath & strFile


'user can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If

exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
*************************************************************************************************************************************************************************************
Sub PDFActiveSheetPOARCHIVE()
'[URL='http://www.contextures.com/']www.contextures.com[/URL]
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim lOver As Long
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")


'get active workbook folder, if saved
strPath = "G:\Automobiles\Trucks"
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"



strName = wsA.Range("K6").Value _
& " " & wsA.Range("D20").Value


'create default name for savng file
strFile = strName & " " & strTime & ".pdf"
strPathFile = strPath & strFile


'user can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If

exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub

[URL='https://www.mrexcel.com/board/threads/save-defined-range-as-pdf-where-i-choose-the-subfolder-to-place-the-file.1201022/reply?quote=5862885']Quote[/URL] [URL='https://www.mrexcel.com/board/threads/save-defined-range-as-pdf-where-i-choose-the-subfolder-to-place-the-file.1201022/reply?quote=5862885']Reply[/URL]

 

[Micron]

1) one solution would be to use Dir function, which will allow you to exit if file exists, or overwrite it
Dir function (Visual Basic for Applications)
2) it looks like you figured that one out. Last post looks much better but - it's important to indent each block. Helps, but especially for complicated code. Look how much easier it is to see what belongs to what. Also helps to spot missing lines that terminate a block (such as an If block):

With Worksheets("Sheet10")
   .Activate
   For i = 1 To .Cells(1, Columns.count).End(xlToLeft).Column
      If .Cells(1, i) = strDate Then
         Worksheets("Sheet9").Range("B2:B6").Copy .Cells(2, i)
         Exit For
      End If
   Next
End With

3) very doable. Probably all you need is a yes/no message box.

Dim result As Integer

'code here to do stuff right up to saving file
'Dir to test if file exists using the full path that was created
If Not Dir(yourPathHere) = "" Then 'means this file was found in the specified folder
  result = Msgbox "File exists. Click yes to overwrite; No to cancel"
    If result = vbNo Then Exit Sub 'If yes chosen, this line is ignored and saving process should run
End If

FWIW Section:
You can group Dim statements to compress Dim blocks. I keep like ones together:

Dim strTime As String, strName As String, strPath As String, strFile As String, strPathFile As String

Do not do like this: Dim strTime, strPath, strFile... As String. Only the last one will be string, the rest will be variant.

I like your variable naming convention there - did I suggest that? You can read a variable name 1000 lines down and know it's a string.
For me, too many line continuation characters. Makes for much more scrolling in a forum window (or editor for that matter).

HTH.

 

[Micron]

Forgot to mention in the FWIW section - if you Set an object variable it is commonly considered sage advice to destroy it and reclaim memory before the procedure terminates. That is, right before your exit sub in this procedure:
Set wb = Nothing

Same for any other Set variable. Common to have

YourLineLableHere:
On Error Resume Next
Set wb = Nothing
Exit Here

when it's possible that the timing of the error caused the object variable to be empty. Sometimes you can raise another error by trying to Set to Nothing an object variable which never got instantiated.