Another post by me

[SFPCFS]

Firstly a massive thank you for the help from this forum,

I've been handed the following today as well, which is a little out of my zone, but I am trying to learn it.

I have the following code in a sheet

[INDENT=2]Option Explicit</SPAN>
Sub copySheet()</SPAN>
    Dim ChangeRequestBooks() As Workbook</SPAN>
           Application.ScreenUpdating = False</SPAN>
   
    ChangeRequestBooks = openFiles()    </SPAN>
    If ChangeRequestBooks(0) Is Nothing Then</SPAN>
              MsgBox "Update Cancelled"</SPAN>
    Else</SPAN>
              processFiles ChangeRequestBooks</SPAN>
        MsgBox "Update Complete"</SPAN>
    End If</SPAN>
   
        Application.ScreenUpdating = True</SPAN>
       End Sub</SPAN>
' Prompts the user for a list of files and returns a referece (in an array) to all the files.</SPAN>
' Opens all the files ready to be processed.</SPAN>
Function openFiles() As Workbook()</SPAN>
    Dim Wb() As Workbook</SPAN>
    Dim i As Long, c As Long</SPAN>
    Dim FilesToOpen As Variant</SPAN>
   
    ' tell the user what we want them to do</SPAN>
    MsgBox "Select workbook(s) to copy.", vbApplicationModal</SPAN>
   
    ' note that if you want to have the open dialogue start in a specific folder then</SPAN>
    ' use ChDrive and ChDir (uncoment following section and update it to the correct path)</SPAN>
    'ChDrive "H:"    ' note that if used on multiple systems the drive letter isn't always the same</SPAN>
    'ChDir "H:\1. Finance Shared Services\FINANCE DATA & MI CHANGE\Financial Risk MI Change\Change Request Forms Recived"    ' is the folder spelt wrong? Recived or Received?</SPAN>
    ' prompt the user with an open dialog</SPAN>
    FilesToOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel (*.xl*),*.xl*", Title:="Please select all change request files required", MultiSelect:=True)</SPAN>
   
       If Not IsArray(FilesToOpen) Then</SPAN>
        ReDim openFiles(0)  </SPAN>
        Exit Function  </SPAN>
    End If</SPAN>
   
           For i = LBound(FilesToOpen) To UBound(FilesToOpen)</SPAN>
        ReDim Preserve Wb(c) ' need to create a space in the array for the file we're about to open</SPAN>
        Set Wb(c) = Workbooks.Open(FileName:=FilesToOpen(i), UpdateLinks:=False, ReadOnly:=True)</SPAN>
            c = c + 1</SPAN>
    Next i
[INDENT=2]openFiles = Wb</SPAN>
End Function</SPAN>
Private Sub processFiles(Wb() As Workbook)</SPAN>
    Dim i As Long</SPAN>
    Dim ws As Worksheet</SPAN>
    Dim SourceRange As range, TargetRange As range</SPAN>
   
        Set ws = ThisWorkbook.Worksheets("SummarySheet")</SPAN>
           Set TargetRange = ws.Cells(ws.Cells.Rows.Count, 2)</SPAN>
           Set TargetRange = TargetRange.End(xlUp)</SPAN>
           Set TargetRange = TargetRange.Cells(2, 1)       </SPAN>
   
    For i = LBound(Wb) To UBound(Wb)</SPAN>
        With Wb(i) </SPAN>
            If .Worksheets.Count >= 2 Then</SPAN>
               Set ws = .Worksheets(2)  </SPAN>
                Set SourceRange = ws.Cells(2, 2) </SPAN>
                Set SourceRange = ws.range(SourceRange, SourceRange.End(xlToRight))</SPAN>
                    SourceRange.Copy</SPAN>
                TargetRange.PasteSpecial xlPasteValues</SPAN>
                Application.CutCopyMode = False</SPAN>
                Set TargetRange = TargetRange.Cells(2, 1)</SPAN>
            Else</SPAN>
                MsgBox "Filename: '" & .Name & "', is missing the sheet we need. Skipping it."</SPAN>
            End If</SPAN>
           
            ' close the file we've finished with it now</SPAN>
            .Close SaveChanges:=False    ' false to not attempt to save changes (and not prompt the user for it)</SPAN>
        End With</SPAN>
    Next i</SPAN>
   
    ' by this point all the files that were opened should be closed and we should be looking at the completed SummarySheet table</SPAN>
End Sub</SPAN>
[/INDENT]
</SPAN>[/INDENT]

Into this I need to add that the sheets the user selects are saved as a PDF to a folder that is named after the cell in column a that is the row it is appended to, in the same location as this log is kept

I've recorded this -

[INDENT=2]Option Explicit</SPAN>
Sub Macro1()</SPAN>
'</SPAN>
' Macro1 Macro</SPAN>
'</SPAN>
'</SPAN>
    ChDir _</SPAN>
        "H:\1. Finance Shared Services\FINANCE DATA & MI CHANGE\Financial Risk MI Change\Change Request Forms Recived"</SPAN>
    Workbooks.Open Filename:= _</SPAN>
        "Same as above with filename"</SPAN>
    Range("H10:J10").Select</SPAN>
    ChDir _</SPAN>
        "Same as above but with the filename on were its being saved"</SPAN>
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _</SPAN>
        "H:\1. Finance Shared Services\FINANCE DATA & MI CHANGE\Financial Risk MI Change\Change Request Forms Recived\FS & MI 2\Change Request Form.pdf" _</SPAN>
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _</SPAN>
        :=False, OpenAfterPublish:=True</SPAN>
    Range("Q26").Select</SPAN>
    ActiveWindow.Close</SPAN>
End Sub</SPAN>
[/INDENT]

I can recognize the save as section

I'll be putting the publish to false as there could be multiple uploads at the same time so it would slow the process down a little I think.

Could you help me in terms of how I would go about this?

Fully appreciate this is big ask or at least feels like for me I’m afraid

Thank you for any help</SPAN>


And apologies for missing one of the most important rules
</SPAN>​

</SPAN>
​

 

[xenou]

Nota Bene:

If you don't know your debugging skills then you *must* read this article carefully:
A Day in the Life: Programming: Excel VBA Debugging for Beginners

It's absolutely essential to have these skills handy. Especially in this case you want to step through your code line by line and check what it's doing, what the variables are valued at, where the ranges are set to, and so on...

ξ

 

[SFPCFS]

Thanks xenou I'll read that in depth

I'll try to find out how to attch the log file so you can see it.

The simplest way I can think to explain is that we have a set request form that people use to ask for work to be done by our teams - its used universally by all three teams and is the same layout for all.

To make pulling the data from this request easier they have added 2nd hidden tab which the summary sheet/log file pulls its information from.

I'm now basically finishing this off fully - the new folder (Which we have solved) that has the works unique ID. The final part of this is for the request form to be saved as a PDF in this newly created folder

It seems from what others post on here etc that its easy to save set something to save as a pdf - but this proving trickier in this application

 

[SFPCFS]

I'm assuming that you want your pdf in a folder of it's own, so the fact that the folder already exists is perhaps both a runtime error (can't create a folder that already exists) and a logical error (why are we trying to put the form in this folder if it's already in there)

Answer to this section - the folder created by the add on code I wrote is the folder I want tto save the PDF in - upto the point were I create the folder here it doen't exsist

Why do you think the folder already exists - was it created before in your run, or in a previous test run, or some other time? Are we trying to put two forms into the same folder and is that a problem?

In every previosu test I have always deleted the folders / data from the SummarySheet to reset this and start agin, this has not caused any issues - I've also done this as many times today as well and its worked fine.

I'm trying to use this code to create the PDF

'ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myNewFolderName & "\Request Form", Quality:=xlQualityStandard,
    'IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

when I debug and ask VBA were the error is it highlights this in yellow -

I have added it in the main code under were I have written

Call cellnamedfoldermaker
                ' sub to Make the corrosponding folder

I also get the same issue if I move to the part were we are prepping to close the work sheet

.Close SaveChanges:= False

Apologies I've not yet sussed out how to upload the 2 sheets that make this up

 

[SFPCFS]

NB - So you can see the code as it stands now - baring the Save as PDF section it all works fine and smoothly

Private Sub processFiles(Wb() As Workbook)
    Dim i As Long
    Dim ws As Worksheet
    Dim SourceRange As range, TargetRange As range, FNR As range
    Dim MNFPath As String
    Dim myNewFolderName As String
    
    ' in order to be able to paste our data to the correct place we need to find the target point
    Set ws = ThisWorkbook.Worksheets("SummarySheet")
        ' note the use of 'ThisWorkbook', no matter which book is active this will always refer to the book that contains the code currently running
    Set TargetRange = ws.Cells(ws.Cells.Rows.Count, 2)
        ' by using the row count we avoid any problems if we're in compatibility mode or not, i.e. 65536 rows vs. 1048576
    Set TargetRange = TargetRange.End(xlUp)
        ' Target Range now points to the last filled row of the summary sheet (or the header)
        ' need to move it down one cell
    Set TargetRange = TargetRange.Cells(2, 1)   ' note that cell references are relative to the start point (base-1)
        'Set Filsave name value
 
      
    
    ' we now need to look at each change request file and pick up the data contained in the background sheet
    ' loop through each sheet
    For i = LBound(Wb) To UBound(Wb)
        With Wb(i)  ' saying 'With' stops us from having to type Wb(i) every time we need to refer to the workbook we're currently looking at
                    ' any time we want to refer to the workbook now we just start with the dot operator '.' instead
            
            ' we can only do the copy we want if we know the sheet we're looking for exists
            ' if there's only 1 sheet in the source book, it's probably not the right file so skip it
            If .Worksheets.Count >= 2 Then
                ' ideally we should do more testing of the source file before we try and copy from it, validate it is the file type intended
                
                Set ws = .Worksheets(2)   ' new use for Ws variable to refer to second worksheet (that's hidden)
                ' note you can look at the data in the hidden sheet without needing to make it visible
                
                ' find the data we want and get a range reference to it
                Set SourceRange = ws.Cells(2, 2) ' it's better to use index values to locate a cell, instead of the "A1" textual reference
                    ' it's used SheetRef.Cells(Row Number, Column Number) where the numbers start at 1, 1 for the top left corner of the sheet
                Set SourceRange = ws.range(SourceRange, SourceRange.End(xlToRight))
                    ' rather than use a fixed size area for the data, we define it by doing the VBA equivalent of Ctrl+Shift+Right Arrow
                    ' to discover the end point of the range we want (i.e. End(xlToRight)
                    ' the Range property takes the two arguments for the top left corner and bottom right corner of the are we want a reference to
                    
                ' now we can copy and paste the data across
                SourceRange.Copy
                TargetRange.PasteSpecial xlPasteValues
                Application.CutCopyMode = False
                    ' this turns off the copy area (marching ants border) so it doesn't prompt the user when we close the file
                
                ' make sure we move the target paste area on one ready for the next paste (if any)
                Set TargetRange = TargetRange.Cells(2, 1)
                
        Call cellnamedfoldermaker
                ' sub to Make the corrosponding folder
                
                               
                Else
                MsgBox "Filename: '" & .Name & "', is missing the sheet we need. Skipping it."
                
        
                
            End If
            
        
            ' close the file we've finished with it now
            .Close SaveChanges:=False      ' false to not attempt to save changes (and not prompt the user for it)
        End With
    Next i
    
    ' by this point all the files that were opened should be closed and we should be looking at the completed SummarySheet table
End Sub
Function cellnamedfoldermaker() As String
Dim FNR As range
Dim myNewFolderName As String
Dim MNFPath As String
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("SummarySheet")
Set FNR = ws.Cells(ws.Cells.Rows.Count, 2)
Set FNR = FNR.End(xlUp)
Set FNR = FNR.End(xlToLeft)
                 
    MNFPath = "[URL="file://\\mnas01\accdata2\1"]\\mnas01\accdata2\1[/URL]. Finance Shared Services\FINANCE DATA & MI CHANGE\Change Request Log\"
                 
    myNewFolderName = MNFPath & (FNR.Value)
    
    CreateObject("Scripting.FileSystemObject").CreateFolder myNewFolderName
    cellnamedfoldermaker = myNewFolderName
            
                
    'ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myNewFolderName & "\Request Form", Quality:=xlQualityStandard,
    'IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End Function

I've still got the commented out PDF code line in the cellnamedfoldermaker section - though its inactive its there for me to remember what the code was.

Apologies for this getting complicated

 

[SFPCFS]

Ok so one again a long sleepless night and I have re written this code - again.

Success it will pdf and save in a folder

Failure - the Folder name now the 2nd colum not the first colum as I had it before

I have both versions saved but here is the one with the working pdf - I did this last night over team view with a friend who also does vba and MI.

Option Explicit
' always put Option Explicit at the top of any module to force all variable to be declared
' this helps you avoid errors in code
Const PDF_OUTPUT_PATH As String = "[URL="file://\\mnas01\accdata2\1"]\\mnas01\accdata2\1[/URL]. Finance Shared Services\FINANCE DATA & MI CHANGE\Change Request Log\"

Sub copySheet()
    Dim ChangeRequestBooks() As Workbook
        ' this is an array of workbooks, we can set up the code to handle more than one file in one go
    
    ' turns off screen updating to the user to avoid slowdown from drawing updates
    ' note that having screen updating off doesn't affect things like message boxes
    Application.ScreenUpdating = False
    
    ChangeRequestBooks = openFiles()    ' it is not necessary to use 'Call' these days in VBA, it's an archaic form of coding.
        ' openFiles (plural) now will allow the user to select multiple change requests and process all of them one after the other
        ' we pass off the processing of the files to a seperate procedure
    
    ' need to check if the user cancelled or not
    If ChangeRequestBooks(0) Is Nothing Then
        ' user pressed cancel, so do nothing
        MsgBox "Update Cancelled"
    Else
        ' otherwise process and close the files we opened already
        processFiles ChangeRequestBooks
        MsgBox "Update Complete"
    End If
    
    ' clean up
    Application.ScreenUpdating = True
        ' Excel will automatically turn screen updating back on again at the end of running code, but doesn't hurt to do it explicitly.
End Sub
' Prompts the user for a list of files and returns a referece (in an array) to all the files.
' Opens all the files ready to be processed.
Function openFiles() As Workbook()
    Dim Wb() As Workbook
    Dim i As Long, c As Long
    Dim FilesToOpen As Variant
    
    ' tell the user what we want them to do
    MsgBox "Select workbook(s) to copy.", vbApplicationModal
    
    ' note that if you want to have the open dialogue start in a specific folder then
    ' use ChDrive and ChDir (uncoment following section and update it to the correct path)
    'ChDrive "H:"    ' note that if used on multiple systems the drive letter isn't always the same
    'ChDir "H:\1. Finance Shared Services\FINANCE DATA & MI CHANGE\Financial Risk MI Change\Change Request Forms Recived"    ' is the folder spelt wrong? Recived or Received?
    ' prompt the user with an open dialog
    FilesToOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel (*.xl*),*.xl*", Title:="Please select all change request files required", MultiSelect:=True)
    
    ' we need to detect if the user pressed cancel and handle that appropriately
    
    If Not IsArray(FilesToOpen) Then
        ReDim openFiles(0)   ' while we aren't opening any files we need to pass back a value that has meaning to allow it to know we've cancelled
            ' in this case an array with a single value of 'Nothing' in it.
        Exit Function   ' we exit the function here, so none of the code after this is run
    End If
    
    ' FilesToOpen now contains an array of all the files selected (even if it's only one)
    
    ' note that at this point varible 'c' is zero
    
    ' loop through the files to open one by one
    For i = LBound(FilesToOpen) To UBound(FilesToOpen)
        ReDim Preserve Wb(c) ' need to create a space in the array for the file we're about to open
        Set Wb(c) = Workbooks.Open(Filename:=FilesToOpen(i), UpdateLinks:=False, ReadOnly:=True)
            ' We don't update links as we don't want to change the file we're opening
            ' and we mark open it as 'Read Only' for the same reason. This is safer.
        c = c + 1 ' move the counter variable on one so we don't overwrite the workbook we've just opened
    Next i
    
    ' return the array of files we've opened to the user
    openFiles = Wb
End Function
' provided an array of open workbooks will get the 'change request' data from each of them
' and add them to the end of the 'SummarySheet' table
Private Sub processFiles(Wb() As Workbook)
    Dim i As Long
    Dim ws As Worksheet
    Dim SourceRange As range, TargetRange As range
    
    ' in order to be able to paste our data to the correct place we need to find the target point
    Set ws = ThisWorkbook.Worksheets("SummarySheet")
        ' note the use of 'ThisWorkbook', no matter which book is active this will always refer to the book that contains the code currently running
    Set TargetRange = ws.Cells(ws.Cells.Rows.Count, 2)
        ' by using the row count we avoid any problems if we're in compatibility mode or not, i.e. 65536 rows vs. 1048576
    Set TargetRange = TargetRange.End(xlUp)
        ' Target Range now points to the last filled row of the summary sheet (or the header)
        ' need to move it down one cell
    Set TargetRange = TargetRange.Cells(2, 1)   ' note that cell references are relative to the start point (base-1)
    
    
    ' we now need to look at each change request file and pick up the data contained in the background sheet
    ' loop through each sheet
    For i = LBound(Wb) To UBound(Wb)
        With Wb(i)  ' saying 'With' stops us from having to type Wb(i) every time we need to refer to the workbook we're currently looking at
                    ' any time we want to refer to the workbook now we just start with the dot operator '.' instead
            
            ' we can only do the copy we want if we know the sheet we're looking for exists
            ' if there's only 1 sheet in the source book, it's probably not the right file so skip it
            If .Worksheets.Count >= 2 Then
                ' ideally we should do more testing of the source file before we try and copy from it, validate it is the file type intended
                
                Set ws = .Worksheets(2)   ' new use for Ws variable to refer to second worksheet (that's hidden)
                ' note you can look at the data in the hidden sheet without needing to make it visible
                
                ' find the data we want and get a range reference to it
                Set SourceRange = ws.Cells(2, 2) ' it's better to use index values to locate a cell, instead of the "A1" textual reference
                    ' it's used SheetRef.Cells(Row Number, Column Number) where the numbers start at 1, 1 for the top left corner of the sheet
                Set SourceRange = ws.range(SourceRange, SourceRange.End(xlToRight))
                    ' rather than use a fixed size area for the data, we define it by doing the VBA equivalent of Ctrl+Shift+Right Arrow
                    ' to discover the end point of the range we want (i.e. End(xlToRight)
                    ' the Range property takes the two arguments for the top left corner and bottom right corner of the are we want a reference to
                    
                ' now we can copy and paste the data across
                SourceRange.Copy
                TargetRange.PasteSpecial xlPasteValues
                Application.CutCopyMode = False
                    ' this turns off the copy area (marching ants border) so it doesn't prompt the user when we close the file
                
                ' output a pdf copy of the front sheet of workbook
                outputPDFCopy .Worksheets(1), TargetRange.Cells(1, 1).Value
                    ' Scott: note that in order to avoid having to discover the same information we already know you have to pass the key value to the Sub
                    '   I am presuming you want to PDF the front sheet (not the background data we copy from),
                    '   and the folder name is the Title we just copied over to the 'SummarySheet'.
                    '   TargetRange already points at the place where it was copied to, the line below moves it down one so best to do
                    '   this before we change it.
                                
                ' make sure we move the target paste area on one ready for the next paste (if any)
                Set TargetRange = TargetRange.Cells(2, 1)
            Else
                MsgBox "Filename: '" & .Name & "', is missing the sheet we need. Skipping it."
            End If
            
            ' close the file we've finished with it now
            .Close SaveChanges:=False    ' false to not attempt to save changes (and not prompt the user for it)
        End With
    Next i
    
    ' by this point all the files that were opened should be closed and we should be looking at the completed SummarySheet table
End Sub
' creates the folder if required and outputs a copy of the worksheet passed
Sub outputPDFCopy(PDFSheet As Worksheet, FolderName As String)
    Dim OutputPath As String
    
    ' first make the folder in the output location
    ' note that i've made the default output location a constant at the top of the module
    ' called 'PDF_OUTPUT_PATH'. Best practice is to amke constants all caps to make it obvious what they are.
    
    OutputPath = PDF_OUTPUT_PATH & FolderName
    
    ' while you can use the 'FileSystemObject' to do this (its an advanced technique) there's an easier method.
    ' 'MkDir' is built into VBA and will create a folder in the path specified (string), as long as it doesn't already exist
    ' to avoid that being a problem you temporarily disable the error response if it does exist with "On Error Resume Next"
    ' it's up to you to ensure that the path specified in 'PDF_OUTPUT_PATH' exists already, otherwise this will not work.
    On Error Resume Next
    MkDir OutputPath
    On Error GoTo 0
    
    ' now to save the PDF to the new folder
    PDFSheet.ExportAsFixedFormat xlTypePDF, OutputPath & "\Request Form.pdf"
    
    
End Sub

So I return with this to my orginal issue - getting it to use not the target cell, but the cell to the left of the target cell

 

[xenou]

Hi,

So I return with this to my orginal issue - getting it to use not the target cell, but the cell to the left of the target cell

I think, change this:

outputPDFCopy .Worksheets(1), TargetRange.Cells(1, 1).Value

To This:

outputPDFCopy .Worksheets(1), TargetRange.Cells(1, 1).Offset(0, -1).Value

That's the cell to the left of target cell.
ξ

 

[SFPCFS]

Just tried it xenou

got the following error

Run-time error '1004':

Document not saved. The Document may be open, or an error may have been encountered when saving

.

It highlights this line in yellow for the error

PDFSheet.ExportAsFixedFormat xlTypePDF, OutputPath & "\Request Form.pdf"

when you click stop though it has added the details, and created the folder (With the right name) - just not the pdf

If I reset the code it will do all, but with the wrong folder name

 

[xenou]

I don't really know anything about export as PDF. I have only done once or twice, and then just to see how it works (and that was years ago). I can't help with that part.

If we have the wrong folder name again I am ready to give up. We can't seem to get the right folder name. Maybe try Target.Offset(1, 1), or Target.Offset(1,2), or Target.Offset(2,1) -- one of them must be the right folder name!