Create Folders & Subfolders with varying paths dependent on cell values

[Mikeymike_W]

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:

Column A - Market	Column B - Centre	Column C - ID
Australia	Sydney	GHTY6745
Germany	Hamburg	UIFG98078
France	Nancy	RTYU5634
UK	Birmingham	YU6734

<tbody>
</tbody>

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!!

 

[BrianM]

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.

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

 

[Mikeymike_W]

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