Hi guys,

Cheers for the feedback. However Im still not entirely sure on how to go about using this code.
I do not have a list containg all the directories. Rather I wish to use cell referances set as variables to create folders within the directory.


I'Ve included a snapshot of my code (including the given MakeDirectories Sub). Could you offer any advice?

Sub MacroForBranchRetailLists()

MainPath = "Z:\Mike\Retail Sept 2011\Macro\Tony Work"


' Open formatting
 ChDir _
        MainPath
    Workbooks.Open Filename:= _
        MainPath & "\Formatting Macro R2.xls"



Dim filepaths(500) As Variant

    filepaths(1) = "931012"
    filepaths(2) = "931012"
    filepaths(3) = "935247"
    filepaths(4) = "934143"
    filepaths(5) = "931136"
    filepaths(6) = "931063"
    filepaths(7) = "934178"
    . . . . .

    . . . . . 
    filepaths(182) = "934305"
  
  'Loop
For i = 1 To 182 'Or filepaths(i) = ""
    If Len(filepaths(i)) > 0 Then
            ProduceListings (filepaths(i))
       
    End If
Next i


End Sub


Sub ProduceListings(ParentNSC)

MainPath = "Z:\Mike\Retail Sept 2011\Macro\Tony Work\"

'***Copy Data From DumpFile***
    Windows("Sample Data Dump.xls").Activate
        Selection.AutoFilter Field:=1, Criteria1:=ParentNSC
        Range("A1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
            
'***Paste Date Into Template***
    Workbooks.Open Filename:=MainPath & "COINS Template.xls"
        Range("A2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            
        Rows("2:2").Select
        Application.CutCopyMode = False
        Selection.Delete Shift:=xlUp
            
'***Define Region & Branch***
    Region = Range("B2")
    Branch = Range("C2")
            
    Call MakeDirectories(Region, Branch)
            
'***Save File***
    ActiveWorkbook.SaveAs Filename:="Z:\Tony\PCAR\Outputs\CGS Invest Data " & Owner & " " & file_name & ".xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
        
        
' Run Formatting Macro
 '   Application.Run "'FormattingMacroPCAR.xls'!FormattingMacro"

'ActiveWorkbook.Save
ActiveWindow.Close
            
            

        

End Sub














Sub MakeDirectories(Region, Branch)
'Author:    Jerry Beaucaire
'Date:      7/11/2010
'Summary:   Create directories and subdirectories based
'           on the text strings listed in column A
'           Parses parent directories too, no need to list separately
'           10/19/2010 - International compliant
Dim Paths   As Range
Dim Path    As Range
Dim MyArr   As Variant
Dim pNum    As Long
Dim pBuf    As String
Dim Delim   As String

Set Paths = Range("A:A").SpecialCells(xlConstants)
Delim = Application.PathSeparator
On Error Resume Next
    
    For Each Path In Paths
        MyArr = Split(Path, Delim)
        pBuf = MyArr(LBound(MyArr)) & Delim
        For pNum = LBound(MyArr) + 1 To UBound(MyArr)
            pBuf = pBuf & MyArr(pNum) & Delim
            MkDir pBuf
        Next pNum
        pBuf = ""
    Next Path

Set Paths = Nothing

End Sub