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
Bookmarks