Create Folders & Subfolders with varying paths dependent on cell values

Mikeymike_W

Board Regular
Joined
Feb 25, 2016
Messages
171
Hi All,

I am looking for excel to create a file structure with a parent folder and sub folders which will contain a couple of other excel documents, the trigger for this would be when a new entry is made within the spreadsheet. A new entry is made using a userform.

I have quite a large spreadsheet but for simplicity sake lets assuming the following:

[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]Column A - Market[/TD]
[TD]Column B - Centre[/TD]
[TD]Column C - ID[/TD]
[/TR]
[TR]
[TD]Australia[/TD]
[TD]Sydney[/TD]
[TD]GHTY6745[/TD]
[/TR]
[TR]
[TD]Germany[/TD]
[TD]Hamburg[/TD]
[TD]UIFG98078[/TD]
[/TR]
[TR]
[TD]France[/TD]
[TD]Nancy[/TD]
[TD]RTYU5634[/TD]
[/TR]
[TR]
[TD]UK[/TD]
[TD]Birmingham[/TD]
[TD]YU6734[/TD]
[/TR]
</tbody>[/TABLE]


I want to create a Parent Folder which be located in the path \\LISA\Case (and at the end of the file path name will be the market name & "" centre name)

It will then put a sub folder within the folder above which will be named "ID" & "Centre"

Then within this folder two more sub folders called "Design" & "Planning"d

Within the Planning folder I'd like another excel file to be placed within.

If either the market file and\or the centre file does not exist then it would be great if it recognised this and created these two folders aswell.

This seems like a lot to ask but I'm hoping someone can help cause I have absolutely no idea!!
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
MikeyMike,
I'm not a VBA wizard by any stretch, but I do something similar with a few of my processes. I think this gets you in the right direction.

1.Right-click the Sheet tab that contains your data and then click View Code.

The module sheet behind this sheet is opened.

2.Enter the following code into the module sheet:

Note: this file would need to be saved as .xlsm

The macro should initiate when data is entered in column C; which, I assume is one of the entry fields in your userform. I'm not that talented with userforms either; perhaps someone else could help you to ensure the userform entry is enough to initiate the macro.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    Application.ScreenUpdating = False

Dim KeyCells As Range
    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    ' Choose this because it appears to be the last column for entry.
Set KeyCells = Range("C:C")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
    Is Nothing Then
    
'For testing purposes, I used "D:\Test\"; change to suit e.g. \\LISA\Case
  
    Dim lRow As Long
    
    'Selects range of visible data in column A
    With ActiveSheet

        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row

        If lRow < 3 Then Exit Sub

        .Cells(1, 1).Offset(1, 0).Resize(lRow - 1).SpecialCells(xlCellTypeVisible).Select

    End With
    
    'Creates parent folder (Market Name & "" & Centre Name)
    For Each cell In Selection
    
        If Len(Dir("D:\Test\" & cell.Value & " " & cell.Offset(0, 1), vbDirectory)) = 0 Then
            MkDir "D:\Test\" & cell.Value & " " & cell.Offset(0, 1)
        Else
        End If
        
    'Creates sub folder (ID & "" & Centre Name)
    'Creates sub folder(s) (Design, Planning)
        If Len(Dir("D:\Test\" & cell.Value & " " & cell.Offset(0, 1) & "\" & cell.Offset(0, 2) & " " & cell.Offset(0, 1), vbDirectory)) = 0 Then
            MkDir "D:\Test\" & cell.Value & " " & cell.Offset(0, 1) & "\" & cell.Offset(0, 2) & " " & cell.Offset(0, 1)
            MkDir "D:\Test\" & cell.Value & " " & cell.Offset(0, 1) & "\" & cell.Offset(0, 2) & " " & cell.Offset(0, 1) & "\" & "Design"
            MkDir "D:\Test\" & cell.Value & " " & cell.Offset(0, 1) & "\" & cell.Offset(0, 2) & " " & cell.Offset(0, 1) & "\" & "Planning"
      
   Dim NewPath As String
   Dim NewBook As Workbook
   
    'Creates empty .xlsx in Planning sub folder (Not sure this is exactly what you want)
   NewPath = "D:\Test\" & cell.Value & " " & cell.Offset(0, 1) & "\" & cell.Offset(0, 2) & " " & cell.Offset(0, 1) & "\" & "Planning"
    
   Workbooks.Add

   ActiveWorkbook.SaveAs Filename:=NewPath & "\" & "EmptyFile.xlsx", FileFormat:=xlOpenXMLWorkbook
   
    Set NewBook = ActiveWorkbook
    NewBook.Close
    
    Else
    End If
       
    Next cell

    MsgBox "        Directories Created "
    
    End If
    
    Application.ScreenUpdating = True

End Sub
 
Upvote 0
Hi Brian,

Thanks very much for your help.

I'm going to give this a bash and see how it goes, i'll keep you posted

All the best,

Mike
 
Upvote 0

Forum statistics

Threads
1,223,914
Messages
6,175,351
Members
452,638
Latest member
Oluwabukunmi

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