'This function reads data from Excel sheet
'and create folders in the system or shared drive
Sub CreateFolders()
    'Variable declaration
    Dim lCounter As Long
    Dim strFolderPath As String
    'Clear Status column
    Sheet1.Range("E4:E1000").ClearContents
    Sheet1.Range("E4:E1000").Font.Color = vbBlack
    Sheet1.Range("E4:E1000").Interior.Color = vbWhite
    'Loop through all the records in sheet1
    For lCounter = 4 To Sheet1.Range("C" & Sheet1.Rows.Count).End(xlUp).Row
        'Validation - if column C or D has no value go to next record
        If Sheet1.Range("C" & lCounter).Value <> "" And Sheet1.Range("D" & lCounter).Value <> "" Then
            strFolderPath = Sheet1.Range("C" & lCounter).Value
            'If the path is ending with slash then remove
            If InStr(1, Right(strFolderPath, 1), "/") > 0 Or InStr(1, Right(strFolderPath, 1), "\") > 0 Then
                strFolderPath = Left(strFolderPath, Len(strFolderPath) - 1)
            End If
            'Check if the base folder path is valid
            If Dir(strFolderPath, vbDirectory) <> "" Then
                'Check if new folder already exist in the base folder
                If Dir(strFolderPath & "\" & Sheet1.Range("D" & lCounter).Value, vbDirectory) = "" Then
                    'Create new folder
                    MkDir (strFolderPath & "\" & Sheet1.Range("D" & lCounter).Value)
                    'Update the status
                    Sheet1.Range("E" & lCounter).Value = "Folder Created"
                    Sheet1.Range("E" & lCounter).Interior.Color = vbGreen
                Else
                    Sheet1.Range("E" & lCounter).Value = "Folder Already Exist"
                    Sheet1.Range("E" & lCounter).Font.Color = vbRed
                End If
            Else
                Sheet1.Range("E" & lCounter).Value = "Invalid Base Folder Path"
                Sheet1.Range("E" & lCounter).Font.Color = vbRed
            End If
        Else
            Sheet1.Range("E" & lCounter).Value = "Incomplete Details"
            Sheet1.Range("E" & lCounter).Font.Color = vbRed
        End If
    Next
    MsgBox "Done", vbInformation
End Sub