CODEWITHSUNDEEP
vbaexcel
neo
neo

Reputation: 105

Folders creation from Excel list

I have addresses in excel sheet B2-B40. Numbers in C2-C40. And both these columns colored with red and green color, in different rows.

What I am trying to accomplish is:

  1. To create Master folders with different numbers (Column C). Each Master folder with different unique number 2, 3, 5, 8, etc.

  2. Inside each master folder, two different folders, Red & Green. i.e. Inside 2 two separate folders, Red & Green.

  3. Inside Numbered master folder, then red (or green) folder, the folder of that address (Which falls under it). Example B2, Address is 124 X lane and its corresponding number in C2 column is 9. Both B2 & C2 are in red color.

So the folder shall be created as: "9" Inside that "Red" inside that "124 x lane".

So the loop shall read all the addresses and create the master folders, inside those two color folders and inside that all the corresponding addresses to color and number.

What I did was (VBSCRIPT)

ub Make_Directory()
Dim MyRange As Range
Dim Path As String
Path = "C:\"
MkDir Path & "test"
Path = "C:\test\"
'The next line is your list of names
Set MyRange = Sheets("Sheet1").Range("B2:B40")
On Error Resume Next
For Each c In MyRange
MkDir Path & c.Value
Next
On Error GoTo 0
End Sub

What it did is it created all the folders with addresses but all inside test folder. But I am not able to modify it as per my needs.

Help Please.

Thanks in advance.

Excel sheet I created

Upvotes: 2

Views: 493

Answers (1)

Liss
Liss

Reputation: 441

You need to add/change to something like this. You didn't look at column C at all for value, so a loop using row/column reference might make more sense.

Sub Make_Directory()

Dim Path As String
Path = "C:\test"
MkDir Path
Path = Path & "\"

On Error Resume Next

For c = 2 to 40
    MkDir Path & Sheets("Sheet1").Cells(c, 3).Value
    If Sheets("Sheet1").Cells(c,2).Interior.Color = RGB(255,0,0) Then
        MkDir Path & Sheets("Sheet1").Cells(c, 3).Value & "\Red"
        MkDir Path & Sheets("Sheet1").Cells(c, 3).Value & "\Red\" & Sheets("Sheet1").Cells(c, 2).Value
    Else
        MkDir Path & Sheets("Sheet1").Cells(c, 3).Value & "\Green"
        MkDir Path & Sheets("Sheet1").Cells(c, 3).Value & "\Green\" & Sheets("Sheet1").Cells(c, 2).Value
    End If
Next c
On Error GoTo 0

End Sub

Upvotes: 2

Related Questions