Posts by alkaline3

I was able to solve this with ThisWorkbook.Path & "\"

Thanks thought it would be more complex, but still tricky for a newbie

Except that it's not... It's saving 1 folder above the current folder so saving in Folder2 when my workbook is in Folder1. Folder2 -> Folder1. It is also tacking on the name of the incorrect folder

Hi everyone, I've been trying out a few things to solve for this but can't seem to figure it out...hoping the great community can help

I have code here, which takes excel files and saves them as PDFs based on some specified parameters. Currently, I have to indicate the directory, but I would like it to just save to the current directory. I've highlighted in blue which line it is, this is what I've tried but it saves 1 folder up from the current one and includes the name in the PDF so 'FolderName1.PDF' , 'FolderName2.pdf' and so on. Thank you for your help.

Sub PDF()
Application.DisplayAlerts = False
Dim Fso As Object, Fldr, myPath As String, f As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
myPath = ThisWorkbook.Path
Set Fldr = Fso.getfolder(myPath).Files
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For Each f In Fldr
    If f.Name Like "*.xlsx" Then
        Workbooks.Open Filename:=f, UpdateLinks:=False
        With Workbooks(f.Name)
            If .Sheets.Count >= 6 Then
                For i = 1 To 6
                    .Sheets(i).Select Replace:=False
                Next i
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                myPath & Replace(f.Name, ".xlsx", ".pdf"), Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
                False
                Workbooks(f.Name).Close savechanges:=False
            Else
                MsgBox "File: " & f.Name & " has fewer than 6 sheets and will be skipped"
                Workbooks(f.Name).Close savechanges:=False
                
            End If
        End With
    End If
Next f
Application.ScreenUpdating = True
End Sub

Thank you that seems to have worked , I also added UpdateLinks:=False below for good measure..

For Each f In Fldr
    If f.Name Like "*.xlsx" Then
        Workbooks.Open Filename:=f, UpdateLinks:=False
        With Workbooks(f.Name)

I tried that after a bit of googling but that didn't do the trick

Quick follow up on this...is there a way to ignore an external links prompt when running the excel to PDF code? Each time the code looks to open the file, I'm prompted with the below screenshot. I'd like to bypass this as "Don't Update" and not see this pop as it interrupts the loop..

Yes that has solved it!! Thanks so much for taking a look and helping out

Appears to still have the issue

Also only the folder name is included in the pdf file name, not the entire path

I tried that but the files no longer save out to the location..

Awesome! This works great! One small thing is when the file names are saved it includes the folder location in the PDF name. I tried a couple things and can't seem to make it go away..

So "TESTLemon, Liz.pdf"

Just wanted to post that I changed my approach to the problem and it was solved elsewhere. Thank you

https://www.mrexcel.com/board/…21794/page-4#post-5413097

Hi everyone, in the process of learning VBA and appreciate help on these great forums..

I have many xlsx files located in a folder, I'd like to:

Loop through each one, select the first 6 sheets, and save down as a PDF with the same name (can be in same directory or in a new folder)

For example Lemon,Liz.xlsx has about 10 tabs (could be more added later) but I want only the first 6 (will always be located first) to be saved down as Lemon,Liz.pdf then loop to the next name.

Thank you for any guidance.

Also, I posted this question here as I'm in a bit of a pinch and spreading out the resources

https://www.mrexcel.com/board/…f-with-same-name.1121933/

I apologize, I didn't mean to offend anyone. Was just trying to get help in different places as I hadn't had luck in responses. I greatly appreciate the code and help in this process, it's been difficult to find a solution on my own and these forums have been a life saver

Yes, that was my intention! I had tried to delete this thread, but saw that I would have needed to post the link with your help

Awesome, I really appreciate your help. I have to filter each of the 3 Data tabs for each Name in the Name criteria tab, except I also need to either clear the contents after the filter that don't meet that criteria, or paste into another worksheet.

My actual workbook is a bit more complicated and I have references these worksheets so I need the cells to line up properly.

So process is:

1. You have 3 sheets with names in - Yes Names are all in Column A

2. You need to filter each of those lists to create a new workbook with each name's data. - Yes, but with just that Names criteria, so either cleared for other Names data or Pasted into PasteData tab

3. Are you needing data from each source sheet into the new workbook? - Yes, I'd like the full workbook saved down

Thank you again, let me know any other questions

I'm not sure I'm following ... I have 3 sheets I've copied to. I think this code was close except I need to replace this line somehow for it to save out the files as it filters through

 'Save the file here using the name in nme.value '??? How to save??? & ThisWorkbook.Path & Application.PathSeparator & nme.Value & ".xlsm"

Sub Filter()
With Sheets("Names")
 Set rngListOfNames = .Range(.Range("A1"), .Range("A1").End(xlDown))
 Set rngListOfNames = Intersect(rngListOfNames, rngListOfNames.Offset(1))
 'Application.Goto rngListOfNames
 Set rngCriteria = .UsedRange.Offset(, .UsedRange.Columns.Count + 1).Resize(2, 1)
 'Application.Goto rngCriteria
 rngCriteria.Cells(1).Value = "Name"
End With
Set SourceSheets = Sheets(Array("Data1", "Data2", "Data3"))
Set DestnSheets = Sheets(Array("PASTEData1", "PASTEData2", "PASTEData3"))
For Each nme In rngListOfNames.Cells
 rngCriteria.Cells(2).Value = nme.Value
 For i = 1 To SourceSheets.Count
 'DestnSheets(i).Activate
 DestnSheets(i).Range("A1").CurrentRegion.Clear
 SourceSheets(i).Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCriteria, CopyToRange:=DestnSheets(i).Range("A1"), Unique:=False
 Next i
 'Stop
 'Save the file here using the name in nme.value
 '??? How to save??? & ThisWorkbook.Path & Application.PathSeparator & nme.Value & ".xlsm"
Next nme
rngCriteria.Clear
End Sub

When I run the code I get Subscript out of range error and when I hit debug it highlights DestnSheets(i).Copy, when I hover over the highlighted line I don't see any detail

Still seem to have error on the DestnSheets(i).Copy line..

I would like to avoid the prompt for the Name and just set it as the Name that was filtered for..