Creating folder, subfolder and subsubfolder based on range

PrinceOfDarkness

New Member
Joined
Nov 10, 2018
Messages
3
Office Version
  1. 365
Platform
  1. Windows
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:
Range.png


This is the output I'd like:
Output in folders.png


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!
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
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.

VBA Code:
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
 
Upvote 1
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.

VBA Code:
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:
Basic.png


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

VBA Code:
    '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:

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

VBA Code:
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:
NoNeed.png


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..?
VBA Code:
    '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.
 
Upvote 0
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..?
VBA Code:
'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.
VBA Code:
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
 
Upvote 1
Solution
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.
VBA Code:
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!
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,175
Members
453,021
Latest member
Justyna P

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