Create Folders & Sub-Folders as per cell of Excel

[poonamSS]

Dear Sir,
This is my excel:

Sr.No.	Total Link loan	Unique ID	Loan_No	Link Loan No. 2	Link Loan No. 3	Link Loan No. 4
8	4	9814829	1747399	13132286	5527073	2989781
10	4	9808897	9865324	3712775	13290211	1161743
1	2	524444	6477143
2	1	9353504	6431728
3	2	9808823	8386959
4	3	9355051	12828878	4161001	4249675
5	3	9816759	2531911	2343837	13167967
6	3	10176929	13640742	3471767	6170740
7	3	10177845	13292602	9250468	3591255
9	3	9899333	13361425	1931880	4538703

Unique ID is my main Folder - Loan_No, Link Loan No. 2, Link Loan No. 3 & Link Loan No. 2 are subfolders in Unique ID Folder.

I need Path of Folders to be: C:\Users\Admin\Dropbox\poonam\(Insert Unique ID Folder)\(subfolder name)


so Folder “Poonam” will have Folder “9814829” and subfolders “1747399”, “13132286”,”5527073”, “2989781”

the path will be like this
C:\Users\Admin\Dropbox\poonam\9814829\1747399
C:\Users\Admin\Dropbox\poonam\9814829\13132286
C:\Users\Admin\Dropbox\poonam\9814829\5527073
C:\Users\Admin\Dropbox\poonam\9814829\2989781

kindly help me with a VBA for the same at the earliest. Thank you

 

[Zot]

Try this

Sub CreateFolder()

Dim FPath As String, newDir As String
Dim cell As Range, col As Range, rngFolder As Range, rngCol As Range
Dim ws As Worksheet

Set ws = ActiveWorkbook.Sheets("Sheet1")  ' chage if necessary
Set rngFolder = ws.Range("C2", ws.Cells(Rows.Count, "C").End(xlUp))

FPath = "C:\Users\Admin\Dropbox\poonam\"
For Each cell In rngFolder
    newDir = FPath & cell & "\"
    MkDir newDir
    Set rngCol = ws.Range("D" & cell.Row, ws.Cells(cell.Row, Columns.Count).End(xlToLeft))
    For Each col In rngCol
        MkDir newDir & col
    Next
Next

End Sub

 

[Marc L]

Hi, a VBA demonstration to paste to the top of the worksheet module (for Excel versions prior to 2010 version remove PtrSafe statement) :​

Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal DirPath$) As Boolean

Sub Demo1()
           Const P = "C:\Users\Admin\Dropbox\poonam\"
             Dim V
    With [A1].CurrentRegion.Rows("2:" & [A1].CurrentRegion.Rows.Count).Columns
        For Each V In Evaluate("""" & P & """&" & .Item(3).Address & "&""\""&" & .Item(4).Resize(, .Count - 3).Address)
          If Not V Like "*\" Then MakeSureDirectoryPathExists V & "\"
        Next
    End With
End Sub

 

[poonamSS]

Thanks a lot, its working perfectly.

 

[Pinaceous]

Hi, a VBA demonstration to paste to the top of the worksheet module (for Excel versions prior to 2010 version remove PtrSafe statement) :​

Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal DirPath$) As Boolean

Sub Demo1()
           Const P = "C:\Users\Admin\Dropbox\poonam\"
             Dim V
    With [A1].CurrentRegion.Rows("2:" & [A1].CurrentRegion.Rows.Count).Columns
        For Each V In Evaluate("""" & P & """&" & .Item(3).Address & "&""\""&" & .Item(4).Resize(, .Count - 3).Address)
          If Not V Like "*\" Then MakeSureDirectoryPathExists V & "\"
        Next
    End With
End Sub

Hello,

I was directed to your thread and it does work wonderfully!

BUT, how can I change your code to start with a cell for example "C2" then put subfolders inside of it from that column in lieu of the row as indicated by the code in reply here?

Please let me know because I know it is NOT:

  With [A1].CurrentRegion.Column("2:" & [A1].CurrentRegion.Rows.Count).Columns

Thank you!
-Pinaceous

 

[Marc L]

​

Better to hijack this thread let's continue on your opened thread where I have linked this one​

where you should elaborate and detail your source range or better just attaching a sample via XL2BB or via a files host website …​

 

[Pinaceous]

Okay, thanks Marc L! I'll post there.