The file path doesn't work when:
Path = Sheets("Sheet1").Range("C2").Value & "\"
The file path in C2 doesn't include \ at the end
Sub Make_Folders_And_SubFolders()
Dim GPath, GName, UName, UGroup As String
Dim UserID, Groups, G, U As Range
Dim Gcounter, Ucounter As Integer
GPath = Sheets("Sheet1").Range("C2").Value & "\"
On Error GoTo Finish
If Len(GPath) = 0 Or Right(GPath, 1) <> "\" Then
Finish:
MsgBox "Please, check if:" & vbNewLine _
& "1- Folder Path is empty." & vbNewLine _
& "2- or "" \ "" is missing at the end of the path." & vbNewLine _
& "3- or Path does not exist.", vbCritical
Exit Sub
End If
Set Groups = Sheets("Sheet1").Range(Cells(5, "P"), Cells(Rows.Count, "P").End(xlUp))
Set UserID = Sheets("Sheet1").Range(Cells(5, "Q"), Cells(Rows.Count, "Q").End(xlUp))
For Each G In Groups
GName = Trim(G.Value) & "_Group"
If Len(Dir(GPath & GName, vbDirectory)) > 0 Then
GoTo Nxt1
Else
MkDir GPath & GName
Gcounter = Gcounter + 1
End If
Nxt1:
Next G
For Each U In UserID
UName = Trim(U.Value)
UGroup = Trim(U.Offset(0, 1).Value) & "_Group"
If Len(Dir(GPath & UGroup & "\" & UName, vbDirectory)) > 0 Then
GoTo Nxt2
Else
MkDir GPath & UGroup & "\" & UName
Ucounter = Ucounter + 1
End If
Nxt2:
Next U
If Gcounter + Ucounter = 0 Then
MsgBox "All Folders exist, " & vbNewLine & "No folder to be created"
Else
MsgBox "Job Done !!" & vbNewLine _
& "Group Folders created: = " & Gcounter & vbNewLine _
& "User ID Folders created: = " & Ucounter, _
Title:="Foders Created Count"
End If
End Sub