Another post by me

SFPCFS

New Member
Joined
Feb 7, 2014
Messages
40
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

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


Code:
[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>
 
Hmmm, so is it working or not? I don't know what is on your sheets. My gut feeling is that if it doesn't work its because you aren't really navigating the worksheets correctly.
 
Upvote 0

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
Up to the folder name and pdf, it works fine - and when you stop on the error that sometimes gets created by this part of the code and click stop it still has worked in terms of uploading the set data

Its just that part that isn't working

Is this save part in thw wrong part of the code possiable? Cause there is a section after that currently stops the user from saving the sheet - should the save section be in there?

It feels very close but its just these last 2 parts that are proving complex - all though idividually they are relatively simple I guess?
 
Last edited:
Upvote 0
Ok I'm refusing to let this beat me - even with my relatively low knowladge

I've written the follwoing - which creates the folder based off the cell referance as I want it to

Code:
Sub cellnamedfoldermaker()
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
                
                
    'ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myNewFolderName & "\Request Form", Quality:=xlQualityStandard,
    'IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub

I've commented out the pdf maker cause in this variation it will pdf the wrong sheet

Now - Am I right in thinking that if I add in a call under the set target range = targetrange.cells(2,1) it should call this sub?

Then I have the issue of saving the request form as a PDF in this folder

Thoughts?
 
Upvote 0
Ok further update

i've put the call in and this seems to work - even for multiple sheets.

Now I have to tackle the pdf side of things

So I have the folder made, with the right name, now i Just need to get it to save the request form as a PDF in that folder then close it

My updated coded reads as follows

Code:
' 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, 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
                
                
                'ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myNewFolderName & "\Request Form", Quality:=xlQualityStandard,
                'IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
                    
                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
Sub cellnamedfoldermaker()
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
                
                
    'ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myNewFolderName & "\Request Form", Quality:=xlQualityStandard,
    'IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub

I've not copied it all in just the part I have added and the part it links to.

Is it possiable to use the referances in that call to copy the requst form there?
 
Upvote 0
Not sure. It sounds like you are saying you want the name of the folder you created. If so, make the routine a function. This will return the path of the folder that you create.
Code:
[COLOR="#FF0000"]Function [/COLOR]cellnamedfoldermaker() [COLOR="#FF0000"]As String[/COLOR]
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 = "\\mnas01\accdata2\1. Finance Shared Services\FINANCE DATA & MI CHANGE\Change Request Log\"
                 
    myNewFolderName = MNFPath & (FNR.Value)
    
    CreateObject("Scripting.FileSystemObject").CreateFolder myNewFolderName
    [COLOR="#FF0000"]cellnamedfoldermaker = myNewFolderName

[/COLOR][COLOR="#FF0000"]End Function[/COLOR]
 
Upvote 0
Can I still call the function in the same way as I have it in my current code?

All I need to do now is save the request form as a pdf in the folder that this sub/function creates?

Sorry been working really hard at this useing the guidence I've read here and what you ahve mentioned as well
 
Upvote 0
Ok changed it to a function - it still works fine, but now its the PDF line that has a syntax error and other issues?

Its just give the following

Run-time error '5':

Invalid Procedure call or argument

this is the last part of this that I need to get right then this will work perfect
 
Last edited:
Upvote 0
Ok for what ever reason when I try to add the pdf code line in it causes the code to fail and break - it says the folder already exsists.

Is the pdf code in the wrong place - should be in the part were we are closing the sheet? so were its closing the sheet instead of just closing the sheet it saves as pdf in that folder.

The missing link is getting it to see that folder, the function part seemed to work then break when you add the pdf side in?

Sorry if this doesn't make sense
 
Upvote 0
Ok update as of now

1 - data still appends fine from multiple sheets
2 - It creates the folders with the right name fine as well

Outstanding issue is getting it to pdf the form into the created folder

I've peice by peice built the function in as per the direction above and none of that causes the issue thus far.

Now I need to do the save as pdf in the created folder and call it Request Form

Its just the pdfing that I can't get now - its very close but its just this last step that is missing / killing the code in its current format
 
Upvote 0
Typically when you make a folder (or really any kind of file input/output) you need to beware of errors. So if the folder already exists, that would be an error, which you either trap and handle using VBA's error handling, or you avoid by checking if the folder exists before you try to create it. 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). I was hoping this wouldn't happen because we are having loads of trouble already, but I guess here we are. 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?

Note: You might consider at some point posting some sample data (the summary sheet especially). I'm trying to work out what's in it from the code and if the code is wrong then so am I!
 
Last edited:
Upvote 0

Forum statistics

Threads
1,215,575
Messages
6,125,631
Members
449,241
Latest member
NoniJ

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
Back
Top