Creating folder, subfolder and subsubfolder based on range

[PrinceOfDarkness]

Dear Excel friends,

Sorry for asking sort of the same question like many have before me. Of course I searched the internets but can't find a solution that meets my query, maybe one of you could help me? I am in the learning process of VBA but I am not that skilled to create it myself although I can pretty much alter existing codes.

I even find it hard to put the question in words so I thought maybe two images would speak for itself... I hope...

This is my range I have in the Excel sheet:

This is the output I'd like:

There are few things that make this such a pain:
1. Sometimes the Country is not known, so the cell value for Country is empty.
In that case the cell value of City goes direct under the root folder World.
2. Sometimes the City folder is not known, so the cell value for City is empty.
In that case the cell value of Number goes direct under the Country folder (if known) otherwise in the root folder World.
3. The amount of Number varies every project but does not exceed 50.

Last but not least, I have a folder (with contents) called Basic which is stored here: C:\Temp\Basic\.
In any of the numbered folders (in this example folders 1-18) should be copied the Basic folder.

I am very sorry for posting such difficult request but on the other hand you may find yourself a challenge over here
Basically if you look at it in reverse it is (in this example) the creation of 18 numbered folders divided by city and again divided by country.

Thanks for helping me out with this one!

 

[John_w]

I have a folder (with contents) called Basic which is stored here: C:\Temp\Basic\.
In any of the numbered folders (in this example folders 1-18) should be copied the Basic folder.

The macro below creates the required folder structure.

The above quoted part is a bit ambiguous to me. The macro copies the C:\Temp\Basic\ folder and its contents to each of the 1-18 numbered folders.

Public Sub Create_Folder_Structure()

    Dim rRows As Range, rRow As Range, rCell As Range
    Dim rootFolder As String, basicFolder As String, path As String
        
    rootFolder = "C:\World"
    basicFolder = "C:\Temp\Basic"
    
    Set rRows = ActiveSheet.UsedRange.Offset(1).Rows
    Set rRows = rRows.Resize(rRows.Rows.Count - 1)
    
    For Each rRow In rRows
        path = rootFolder
        For Each rCell In rRow.Cells
            If Not IsEmpty(rCell.Value) Then path = path & "\" & rCell.Value
        Next
        Shell "cmd /c mkdir " & Chr(34) & path & Chr(34)
        Shell "cmd /c xcopy " & Chr(34) & basicFolder & Chr(34) & " " & Chr(34) & path & Chr(34) & " /E /Y"
    Next
    
End Sub

 

[PrinceOfDarkness]

The macro below creates the required folder structure.

The above quoted part is a bit ambiguous to me. The macro copies the C:\Temp\Basic\ folder and its contents to each of the 1-18 numbered folders.

Public Sub Create_Folder_Structure()

    Dim rRows As Range, rRow As Range, rCell As Range
    Dim rootFolder As String, basicFolder As String, path As String
       
    rootFolder = "C:\World"
    basicFolder = "C:\Temp\Basic"
   
    Set rRows = ActiveSheet.UsedRange.Offset(1).Rows
    Set rRows = rRows.Resize(rRows.Rows.Count - 1)
   
    For Each rRow In rRows
        path = rootFolder
        For Each rCell In rRow.Cells
            If Not IsEmpty(rCell.Value) Then path = path & "\" & rCell.Value
        Next
        Shell "cmd /c mkdir " & Chr(34) & path & Chr(34)
        Shell "cmd /c xcopy " & Chr(34) & basicFolder & Chr(34) & " " & Chr(34) & path & Chr(34) & " /E /Y"
    Next
   
End Sub

Dear John_w,

First of all: WOW! Thanks for understanding exactly what I mean, I would have thought it would be hard to understand me. You have done a great job. The ambiguous part is understood correctly as well: I keep some folders and files in the Basic folder which need to be copied into every numbered folder and that is what this VBA code does. At this moment (test phase) this is the contents of the Basic folder:

I noticed the folder World is created directly in the root of C:\ so I changed this part:

    'rootFolder = "C:\World"
    rootFolder = Application.ActiveWorkbook.path & "\World\"

It will now be created in the folder of where my Excel document sits. This is the code so far:

Public Sub Create_Folder_Structure()

    Dim rRows As Range, rRow As Range, rCell As Range
    Dim rootFolder As String, basicFolder As String, path As String
        
    'rootFolder = "C:\World"
    rootFolder = Application.ActiveWorkbook.path & "\World\"
    basicFolder = "C:\Temp\Basic"
    
    Set rRows = ActiveSheet.UsedRange.Offset(1).Rows
    Set rRows = rRows.Resize(rRows.Rows.Count - 1)
    
    For Each rRow In rRows
        path = rootFolder
        For Each rCell In rRow.Cells
            If Not IsEmpty(rCell.Value) Then path = path & "\" & rCell.Value
        Next
        Shell "cmd /c mkdir " & Chr(34) & path & Chr(34)
        Shell "cmd /c xcopy " & Chr(34) & basicFolder & Chr(34) & " " & Chr(34) & path & Chr(34) & " /E /Y"
    Next
    
End Sub

The only minor thing I encounter is that the contents of the folder C:\Temp\Basic is also copied into the rootFolder (that is Application.ActiveWorkbook.path & "\World\"). It must not be in there so I searched the VBA code for where this happens. Because it is a copy event I look at the part:

Shell "cmd /c xcopy " & Chr(34) & basicFolder & Chr(34) & " " & Chr(34) & path & Chr(34) & " /E /Y"

This code is copying the contents of the folder specified by the variable basicFolder to the destination folder specified by the variable path.
Because the variable path is World at first, it is copied in there as well, this is where I believe the action is. But I see no possible option to filter out that World folder itself so the contents of Basic folder is not copied in there. To clarify, this is what I do not need:

Any thought on this one?

A final "in-between-question": I noticed I use a "\" at the end of the line where you do not, both seem to work..?

    'rootFolder = "C:\World" <-- the last letter is a "d"
    rootFolder = Application.ActiveWorkbook.path & "\World\" <-- the last letter is a "\"

Thank you again for helping me out, it is much appreciated.

 

[John_w]

The only minor thing I encounter is that the contents of the folder C:\Temp\Basic is also copied into the rootFolder (that is Application.ActiveWorkbook.path & "\World\").

I can only think that it's because the code loops through rows in UsedRange and you might have extraneous cells outside the A2:C<last row> shown in your screenshot which is causing it copy the Basic folder into the root folder. The revised code below loops through rows in A2:C<last row> instead.

Any thought on this one?

A final "in-between-question": I noticed I use a "\" at the end of the line where you do not, both seem to work..?

'rootFolder = "C:\World" <-- the last letter is a "d"
rootFolder = Application.ActiveWorkbook.path & "\World\" <-- the last letter is a "\"

Both the rootFolder and basicFolder paths should not end with a back slash. The code adds the back slash to the rootFolder and each subfolder as it builds the path.

Here's the revised macro.

Public Sub Create_Folder_Structure()
    
    Dim rRows As Range, rRow As Range, rCell As Range
    Dim rootFolder As String, basicFolder As String, path As String
        
    rootFolder = ActiveWorkbook.Path & "\World"
    basicFolder = "C:\Temp\Basic"
    
    With ActiveSheet
        Set rRows = .Range("A2", .Cells(.Rows.Count, "C").End(xlUp))
    End With
    
    For Each rRow In rRows.Rows
        path = rootFolder
        For Each rCell In rRow.Cells
            If Not IsEmpty(rCell.Value) Then path = path & "\" & rCell.Value
        Next
        Shell "cmd /c mkdir " & Chr(34) & path & Chr(34)
        Shell "cmd /c xcopy " & Chr(34) & basicFolder & Chr(34) & " " & Chr(34) & path & Chr(34) & " /E /Y"
    Next
    
End Sub

 

[PrinceOfDarkness]

I can only think that it's because the code loops through rows in UsedRange and you might have extraneous cells outside the A2:C<last row> shown in your screenshot which is causing it copy the Basic folder into the root folder. The revised code below loops through rows in A2:C<last row> instead.



Both the rootFolder and basicFolder paths should not end with a back slash. The code adds the back slash to the rootFolder and each subfolder as it builds the path.

Here's the revised macro.

Public Sub Create_Folder_Structure()
   
    Dim rRows As Range, rRow As Range, rCell As Range
    Dim rootFolder As String, basicFolder As String, path As String
       
    rootFolder = ActiveWorkbook.Path & "\World"
    basicFolder = "C:\Temp\Basic"
   
    With ActiveSheet
        Set rRows = .Range("A2", .Cells(.Rows.Count, "C").End(xlUp))
    End With
   
    For Each rRow In rRows.Rows
        path = rootFolder
        For Each rCell In rRow.Cells
            If Not IsEmpty(rCell.Value) Then path = path & "\" & rCell.Value
        Next
        Shell "cmd /c mkdir " & Chr(34) & path & Chr(34)
        Shell "cmd /c xcopy " & Chr(34) & basicFolder & Chr(34) & " " & Chr(34) & path & Chr(34) & " /E /Y"
    Next
   
End Sub

Thank you very much John_w this works like a charm!
The issue of unwanted folders is now solved as well.

Since this is a part of a much bigger thing I am working on I will move on to the next step. If I encounter any trouble regarding this piece of code I will get back to you.

Again thanks and thumbs up for you!