Auto Folder Creation based on given path/folder names

[harinsh]

Hello Team,
I am looking for the below help in the creation of automation in folder create and assign the names based on the given names in cells/path.

If you see column B and C and it goes on till 10 or so on ....when I run the auto program should create the main folder/subfolders accordingly and incase if given path folder exist no need to create again.

Can anyone help with this requirement?

 

[Yongle]

Sample code for you to test
- validity of folder name is not verified

Amend path to MF1, MF2 etc
fPath = "C:\Folder\subfolder"
Amend worksheet name
Set ws = Sheets("XXX")

Sub CreateFolders()
    Dim fPath As String, p As String, p2 As String, rng As Range, cel As Range, ws As Worksheet, c As Long
    fPath = "C:\Folder\subfolder"
    Set ws = Sheets("XXX")
    Set rng = ws.Range("A4", ws.Range("A" & ws.Rows.Count).End(xlUp))
    On Error Resume Next
    For Each cel In rng
        p = fPath & "\" & cel
        If cel <> "" Then
            MkDir p
            For c = 1 To 50
                p2 = p & "\" & cel.Offset(, c)
                If Not p2 = p & "\" Then MkDir p2
            Next c
        End If
    Next cel
    On Error GoTo 0
End Sub

If you cannot make it work, post the amended code you are using and the actual worksheet range - and I will try to help resolve any issues

XL2BB - Excel Range to BBCode

Excel 'mini-sheet' in messages - XL2BB Although experts prefer to read your description and question instead of working in your actual file to solve your problem, there are times that it is difficult to explain an issue without providing actual...

www.mrexcel.com

 

[harinsh]

Sample code for you to test
- validity of folder name is not verified

Amend path to MF1, MF2 etc
fPath = "C:\Folder\subfolder"
Amend worksheet name
Set ws = Sheets("XXX")

Sub CreateFolders()
    Dim fPath As String, p As String, p2 As String, rng As Range, cel As Range, ws As Worksheet, c As Long
    fPath = "C:\Folder\subfolder"
    Set ws = Sheets("XXX")
    Set rng = ws.Range("A4", ws.Range("A" & ws.Rows.Count).End(xlUp))
    On Error Resume Next
    For Each cel In rng
        p = fPath & "\" & cel
        If cel <> "" Then
            MkDir p
            For c = 1 To 50
                p2 = p & "\" & cel.Offset(, c)
                If Not p2 = p & "\" Then MkDir p2
            Next c
        End If
    Next cel
    On Error GoTo 0
End Sub

If you cannot make it work, post the amended code you are using and the actual worksheet range - and I will try to help resolve any issues

XL2BB - Excel Range to BBCode

Excel 'mini-sheet' in messages - XL2BB Although experts prefer to read your description and question instead of working in your actual file to solve your problem, there are times that it is difficult to explain an issue without providing actual...

www.mrexcel.com

Thank you very much ..it's working super....