Creating Sub Folders in VBA - vba

Question

Having some problem with my macro which I can't seem to figure out :(
I have a main folder called "Divisions" in my desktop. I would like to create two types of sub folders - Individual Division folders (e.g. Div1, Div2, Div3) and Individual Officer folders (e.g. Div1_Alice, Div2_Bert, Div3_Cindy).
It should be arranged in this way: Desktop>Division folder >Individual Division folders> Individual Officer folders.
I have created the macro below with the help of a Youtube tutorial but it dosen't seem to work when I try to create two types of sub folders at once.
Would appreciate any help please!
(Btw the status column is just to update whether the folder has been created or not)
Name
Division
Name + Division
Status
Alice
Div1
Div1_Alice
Bert
Div2
Div2_Bert
Cindy
Div3
Div3_Cindy
Sub Create_Multiple_Folders()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")
Dim sub_folder_path As String
Dim i As Integer
For i = 2 To sh.Range("C" & Application.Rows.Count).End(xlUp).Row
sub_folder_path = sh.Range("E2").Value & "\" & sh.Range("B" & i).Value & "\" & sh.Range("C" & i).Value
If Dir(sub_folder_path, vbDirectory) = "" Then
MkDir (sub_folder_path)
sh.Range("D" & i).Value = "Folder Created"
Else
sh.Range("D" & i).Value = "Folder already available"
End If
Next i
End Sub

Answer 1

It is necessary to create the directory structure sequentially, by levels:
Option Explicit
Sub Create_Multiple_Folders()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")
Dim sub_folder_path As String
Dim i As Integer
For i = 2 To sh.Range("C" & sh.Rows.Count).End(xlUp).Row
' make 1st level - Divisions/DivN
sub_folder_path = sh.Range("E2").Value & "\" & sh.Range("B" & i).Value
If Dir(sub_folder_path, vbDirectory) = "" Then MkDir sub_folder_path
' make 2nd level - Divisions/DivN/DivN_Name
sub_folder_path = sub_folder_path & "\" & sh.Range("C" & i).Value
If Dir(sub_folder_path, vbDirectory) = "" Then
MkDir sub_folder_path
sh.Range("D" & i).Value = "Folder Created"
Else
sh.Range("D" & i).Value = "Folder already available"
End If
Next i
End Sub