Macro to create folders in various locations based on cell values

lux02

New Member
Joined
May 31, 2016
Messages
3
Hi All

Real excel novice here!

I need a macro to create folders based on a cell value (A4:A10), this value is the "job reference". This folder needs to be created in locations based on other values within the spreadsheet. These values are:

Region (EU or Non-EU)
Country (China, France, Bulgaria etc.)
City (Shanghai, Beijing, Arques, Sofia etc.)

The location should look like this:

C:\Excel Directory\REGION\COUNTRY\CITY\"Job Reference" located in A4:A:10

Each row will have a different region, country and city and will therefore need the folders created in multiple locations. I've created a macro to hyperlink to these locations but it involves creating the individual folder manually for each job reference.

Any help would be appreciated as I'm struggling to work out where to start!

Cheers
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

lux02

New Member
Joined
May 31, 2016
Messages
3
P.S. The folders for the region, country and city are already created, it's only the folder for the job reference that needs creating but it needs to be in the correct location.

I guess this involves some kind of look up.

As I said before, massive novice here!
 

lux02

New Member
Joined
May 31, 2016
Messages
3
Seems I've somehow managed to get a macro working that has created all the folders in the correct location but it seems that once it's done it once, it won't work again. Any help would be appreciated.

Sub MakeFolders()
Dim Ref As Range
Dim maxRows, maxCols, r, c As Integer
Dim Reg As Range
Dim Cou As Range
Dim Cit As Range


Set Ref = Range("A4:A500")
Set Reg = Range("B4:B500")
Set Cou = Range("C4:C500")
Set Cit = Range("D4:D500")

maxRows = Ref.Rows.Count
maxCols = Ref.Columns.Count
For c = 1 To maxCols
r = 1
Do While r <= maxRows
If Len(Dir("C:\2016 Orders" & "\" & Reg(r, c) & "\" & Cou(r, c) & "\" & Cit(r, c) & "\" & Ref(r, c), vbDirectory)) = 0 Then
MkDir ("C:\2016 Orders" & "\" & Reg(r, c) & "\" & Cou(r, c) & "\" & Cit(r, c) & "\" & Ref(r, c))
On Error Resume Next
End If
r = r + 1
Loop
Next c
End Sub
 

Forum statistics

Threads
1,143,655
Messages
5,720,112
Members
422,266
Latest member
Mattyw

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
Top