Excel Macro Query

[Kev86]

I know this is a forum for Access however i know people here are good with code and i am hoping someone might be able to help me with some code for an Excel macro i built some time ago.


The code has a path name for exporting sheets from an Excel spreadsheet and then saves each document into separate folders within the folder location where the Excel spreadsheet is stored.

The excel spreadsheet would be stored at the very top of the folder and then just read down through the folders as to where to save each document, as you will see from the path names below it's ActiveWorkbook then finds the folder location to save the document too.



My issue is that there's been a change to the folder design and my Excel document is now stored within another folder deep within the main folder location, my question is, how can i change the path code above to make it look up through the folder rather than just down?

Hope i am making some sense?

[Micron]

as you will see from the path names below it's ActiveWorkbook then finds the folder location to save the document too.

I see nothing. Did you forget to post code? If you do, please use code tags ( use # button on posting toolbar) to maintain indentation.

and my Excel document is now stored within another folder deep within the main folder location

Hard for me to follow the scenario. Your "document" is which, the new workbook being created, or the one that's running the code? How about posting the file path you end up with and show what you want it to be. One way may be to take everything up to the last slash, but not sure if that's what you're after.

[Micron]

If you want to move up x levels from a known path there is an answer here by Tim Williams that I tried and it works
https://stackoverflow.com/questions/...rent-directory

You could also use application.thisworkbook.path if you want to move relative to the workbook running the code.

[jojowhite]

you may try to put the Path of the folder in a Cell in a worksheet.
then in your code just refer to this cell.

[Kev86]

Sorry I don't know why the code did not appear, hopefully you can see the code below as it is now...

Path1 = ActiveWorkbook.Path & "\Construction File\Groundworks\" & "RFQ LOCKED_Yr1Rates" & ".xlsx"Path2 = ActiveWorkbook.Path & "\Consents\" & "P&C Request"
Path3 = ActiveWorkbook.Path & "\Customer Correspondence\Mpans\" & "Mpan Request Form"
Path4 = ActiveWorkbook.Path & "\Construction File\Metering\" & "Contractor Work Instruction"
Path5 = ActiveWorkbook.Path & "\Construction File\HSS\" & "Hazard Form"
Path6 = ActiveWorkbook.Path & "\Construction File\" & "Indicative Delivery Timeline"
Path7 = ActiveWorkbook.Path & "\Construction File\" & "Projects Man Hours Calculator"

The new folder layout means that my Excel spreadsheet now resides in \8. Departmental\Projects SPN so I want it to look in ActiveWorkbook move up from Projects SPN to 8. Departmental but then the tricky part is moving up one layer again as the folder name after that can be different as the main folder title is amended based on job number and site address name.

Worst case we will just have to cut and paste the spreadsheet from the Projects SPN folder and place it back at the top of the job folder.

[Kev86]

Thank you Mircon, i will take a look at that link.

[Micron]

\8. Departmental\Projects SPN

that isn't shown in your code and I don't see what the real path is - just a reference to the active wb path, which doesn't really help to pin point the problem. I tried the code and it worked to move up as many folders as input into the sub call. If you don't know how many you need to move up from any given point then not sure you can use it. If you know but it varies from row to row, then perhaps use a helper column with the number of levels to move up and refer to those cells.

Sub tester()
Debug.Print MoveUp(Application.ThisWorkbook.Path, 1)
End Sub

Function MoveUp(ByVal f As String, Optional levels As Long = 1)
Dim n As Long

For n = 1 To levels
    f = CreateObject("scripting.filesystemobject").GetFolder(f).ParentFolder.Path
Next n
MoveUp = f
End Function

Not sure I agree with creating an object in every loop like that. Would have to try creating outside the loop once then find the parent of each loop but don't have the time right now. I also advocate destroying object variables, which for some reason I don't see a lot of that being done in Excel code written by others.

[Kev86]

Sorry Micron i am not explaining it very well. The current spreadsheet sits within a folder and the sub folders are in the same location so the code looks at where the Excel spreadsheet is located by using

ActiveWorkbook.Path

and then from there it finds the folders and exports the relevant sheets to the correct location.

However with a system change within a different team my Excel spreadsheet now sits within sub folders \8. Departmental\Projects SPN so what i want to do with my existing code for the path's in slightly amend it so it looks at the

ActiveWorkbook.Path

then it moves up two folders so goes to the folder above 8. Departmental and then from there it finds the relevant sub folders to store the documents.

Sorry i am no expert at code and my code is very basic and probably not well built but for now it seems to do the trick. Just so happens the process before the folder gets to us has changed slightly and it means my Excel spreadsheet has been pushed into a couple of sub folders so that's where my code then struggles.

The simple fix is to move the Excel spreadsheet out of the sub folder and place it in the folder above 8. Departmental however we would need to this for every job whereas i am hoping it can stay int he subfolders and the code for the path can dot eh work by pushing it up and then back down.

Any idea how I can add that into my existing path codes? Like

Path1 = ActiveWorkbook.Path & "\Construction File\Groundworks\" & "RFQ LOCKED_Yr1Rates" & ".xlsx"

how can i add a bit of code after ActiveWorkbook to move the location up two folders before it starts looking for \Construction File\Groundworks to then save the file RFQ LOCKED_Yr1Rates

[Micron]

The code I posted will return the folder path that is up two levels.

If you want to actually move the workbook that is running the code, you can't. You could copy it there and then close and delete the active workbook but I think that's risky. If I still don't understand what you want, then perhaps take pics of the folder hierarchy that worked and the one that doesn't work now and refer to the pics when explaining what is getting moved to where. Or which folder(s) you want to put the new workbooks into that are made from your spreadsheets (which I presume are being copied from the wb that is running the code).

[Kev86]

Hi Micron, thank you for all your help with this and sorry I am not very good at code so get lost a little. I tried adding your code above but couldn't get it to work however I have probably made an error with adding the path.

Hopefully I can give a bit more detail with my full code and pictures to try and explain things a little better...

Here is an image of the old setup when it worked, I have created a dummy folder for this example but as you will see the folder would have a reference number and site address included. The Master Form v2.5 that sits within it is the spreadsheet with the code, this enables the user to update multiple sheets in one place and then when they hit the Export button the macro runs to export those sheets to the relevant folders within this folder 8500999999 - 10 Downing St London.



However since a change in the team who process the folder before passing it to us has changed this means the Master Form v2.5 no longer resides in the 8500999999 - 10 Downing St London folder level and instead is located further down within the sub folders. Hopefully the picture below shows you where it now resides.



When it's in the 8500999999 - 10 Downing St London folder and drills down into the folders to save the documents it works however when it's embedded into the Projects SPN folder it no longer works as the code starts with ActiveWorkbook as the path location and then works down from there.

Here is all my code built into the macro, probably completely wrong to how you would do it but it works for what I need it to do...

Sub Seperate_Sheets104()

Dim Path1 As String
Dim Path2 As String
Dim Path3 As String
Dim Path4 As String
Dim Path5 As String
Dim Path6 As String
Dim Path7 As String


Application.ScreenUpdating = False


Path1 = ActiveWorkbook.Path & "\5. Construction\Supplier and Subcontractor\" & "RFQ LOCKED_Yr1Rates" & ".xlsx"
Path2 = ActiveWorkbook.Path & "\4. Legal\" & "P&C Request"
Path3 = ActiveWorkbook.Path & "\5. Construction\Metering\" & "Mpan Request Form"
Path4 = ActiveWorkbook.Path & "\5. Construction\Metering\" & "Contractor Work Instruction"
Path5 = ActiveWorkbook.Path & "\5. Construction\H&S\" & "Hazard Form"
Path6 = ActiveWorkbook.Path & "\5. Construction\" & "Indicative Delivery Timeline"
Path7 = ActiveWorkbook.Path & "\5. Construction\" & "Projects Man Hours Calculator"


Sheets("2. Request for Quote").Select
    Range("J7:K7").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F9:G9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J9:K9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F14:G14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F16:G16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F18:G18").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("K14:K17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J18:K18").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G10").Select
    Sheets("MASTER").Select
    Range("B2").Select


Sheets(Array("1.Front Sheet", "2. Request for Quote", "3. Quote", "Procurement Input", "SoR")).Copy
    ActiveWorkbook.SaveAs Filename:=Path1, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Protect Password:="UKPN01!", Structure:=True, Windows:=True
    ActiveWindow.Close
 
Sheets(Array("P&C Request")).Copy
    ActiveWorkbook.SaveAs Filename:=Path2, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    
Sheets(Array("MPAN Form", "TECHNICAL")).Copy
    ActiveWorkbook.SaveAs Filename:=Path3, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    
Sheets(Array("UKPN CWI", "Job Type detail", "Master data for form")).Copy
    ActiveWorkbook.SaveAs Filename:=Path4, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    
Sheets(Array("Hazard Form", "Hazard Notes", "Risk Rating & Hazard Categories")).Copy
    ActiveWorkbook.SaveAs Filename:=Path5, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
   
Sheets(Array("Indicative Delivery Plan", "Delivery Time Estimator", "Tasks")).Copy
    ActiveWorkbook.SaveAs Filename:=Path6, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close


Sheets(Array("CONTROL", "Guidance", "Calculator", "CU Master Data")).Copy
    ActiveWorkbook.SaveAs Filename:=Path7, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Workbooks.Open Filename:=Path1
ActiveWorkbook.Protect "UKPN101!", Structure:=True, Windows:=False
    ActiveWorkbook.Save
    ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True


   
Sheets("2. Request for Quote").Select
Range("J7:K7").Select
    ActiveCell.FormulaR1C1 = "=MASTER!R[-5]C[-8]"
    Range("F9:G9").Select
    ActiveCell.FormulaR1C1 = "=MASTER!R[6]C[-4]"
    Range("J9:K9").Select
    ActiveCell.FormulaR1C1 = "=MASTER!R[10]C[-8]"
    Range("F14:G14").Select
    ActiveCell.FormulaR1C1 = "=MASTER!R[-7]C[-4]"
    Range("F16:G16").Select
    ActiveCell.FormulaR1C1 = "=MASTER!R[-4]C[-4]"
    Range("F18:G18").Select
    ActiveCell.FormulaR1C1 = "=MASTER!R[-5]C[-4]"
    Range("K14:K17").Select
    ActiveCell.FormulaR1C1 = "=MASTER!R[-10]C[-9]"
    Range("J18:K18").Select
    ActiveCell.FormulaR1C1 = "=MASTER!R[-13]C[-8]"
    Range("K19").Select


Sheets("MASTER").Select
    Range("B2").Select




Application.ScreenUpdating = True


MsgBox ("Export Complete")




End Sub

[jojowhite]

you need to remove the Activeworkbook.Path from the code.
and assign a Constant variable for the Root folder.
or Manually assign the path.

[Welshgasman]

Why not move the Excel file to the original location and carry on as normal?

[Kev86]

JoJowhite how do i do that? How will the code look once amended in the path?

Welshgasman yes that will be the answer in the end if we can't get the code to work for us, just annoying to have to do that for every job as we deal with tens of thousands of jobs per year so soon adds up

[Welshgasman]

JoJowhite how do i do that? How will the code look once amended in the path?

Welshgasman yes that will be the answer in the end if we can't get the code to work for us, just annoying to have to do that for every job as we deal with tens of thousands of jobs per year so soon adds up

Well you need some consistency on where the new location is, or a definite way to determine it.
You could always ask that other department to put it back the way it was? They might not know how much trouble it is causing you?

When I worked for a large bank, they just chucked a mountain of data at us, and I had to extract what we needed for that day. They did that to all the locations that did our work, which is why my Flow Leaders asked me to create a database, as it took them almost an hour to do it manually in Excel.

[jojowhite]

does the the Folders on network drive or just local in this computer?