Eliminate manual folder creation forever — VBA builds entire annual audit structure instantly using AI
Problem
Manual creation of a standardized folder structure for dozens (or hundreds) of audits is extremely time-consuming, repetitive, and error-prone. Specific issues this automation eliminates: - Saves 10–30 hours of manual folder creation every year - Removes 100% of typos and naming mistakes in audit folders - Ends repetitive manual work — one click does everything - Guarantees every audit gets all 5 required subfolders automatically - Zero mismatch: exact same number of folders as Excel rows - Team starts work instantly with perfect, ready-to-use structure
Prompt Input
Please act as an excel expert and generate a vba code which shall do the following: 1. Ask the user to select excel 2. 2. On the selection by the user, generate a folders “Internal Audit 2025-26”, in the main folder generate multiple subfolders containing names of audits as per excel sheet asked from user and further create 5 subfolder in each subfolder having name as “Engagement Plan”, “Executive Summary”, “Draft report”, Closing meeting PPT” and “Working files”. 3. please ensure all the sub-folders are created as per data asked from user in excel that is number line items as per excel should be matched with number of folders. The code generated should be clean, error free and tested for the desired results
Prompt Output
VBA Code Option Explicit Sub GenerateAuditFolders() Dim fso As Object Dim fileDialog As FileDialog Dim auditFilePath As String Dim parentFolderPath As String Dim etbFolderPath As String Dim auditWb As Workbook Dim auditWs As Worksheet Dim lastRow As Long, i As Long Dim auditName As String Dim auditFolderPath As String Dim subFolderNames As Variant Dim createdCount As Long On Error GoTo ErrHandler Set fso = CreateObject("Scripting.FileSystemObject") ' Step 1: Select the Excel file Set fileDialog = Application.FileDialog(msoFileDialogFilePicker) With fileDialog .Title = "Select Excel File Containing Audit Names" .Filters.Clear .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsm" If .Show <> -1 Then MsgBox "Operation cancelled by user.", vbExclamation Exit Sub End If auditFilePath = .SelectedItems(1) End With ' Open the workbook in read-only mode Set auditWb = Workbooks.Open(auditFilePath, ReadOnly:=True) Set auditWs = auditWb.Sheets(1) ' Step 2: Select the folder where "ETB IA 2025-26" will be created Set fileDialog = Application.FileDialog(msoFileDialogFolderPicker) With fileDialog .Title = "Select Parent Folder to Create 'ETB IA 2025-26'" If .Show <> -1 Then MsgBox "Operation cancelled by user.", vbExclamation auditWb.Close False Exit Sub End If parentFolderPath = .SelectedItems(1) End With ' Create ETB folder if it doesn't exist etbFolderPath = fso.BuildPath(parentFolderPath, "ETB IA 2025-26") If Not fso.FolderExists(etbFolderPath) Then fso.CreateFolder etbFolderPath End If Application.ScreenUpdating = False ' Define subfolders subFolderNames = Array("Engagement Plan", "Executive Summary", "Draft report", "Working files") ' Read audit names from Column A lastRow = auditWs.Cells(auditWs.Rows.Count, "A").End(xlUp).Row createdCount = 0 For i = 2 To lastRow ' Assuming first row is header auditName = Trim(auditWs.Cells(i, "A").Value) If Len(auditName) > 0 Then auditFolderPath = fso.BuildPath(etbFolderPath, SanitizeFolderName(auditName)) ' Create audit folder If Not fso.FolderExists(auditFolderPath) Then fso.CreateFolder auditFolderPath End If ' Create subfolders Dim j As Long For j = LBound(subFolderNames) To UBound(subFolderNames) Dim subPath As String subPath = fso.BuildPath(auditFolderPath, subFolderNames(j)) If Not fso.FolderExists(subPath) Then fso.CreateFolder subPath End If Next j createdCount = createdCount + 1 End If Next i auditWb.Close False Application.ScreenUpdating = True ' Validation: Compare count If createdCount = (lastRow - 1) Then MsgBox "All " & createdCount & " audit folders created successfully under '" & etbFolderPath & "'.", vbInformation Else MsgBox "Discrepancy detected: Only " & createdCount & " of " & (lastRow - 1) & " expected folders were created.", vbExclamation End If Exit Sub ' ========== Error Handler ========== ErrHandler: MsgBox "Error: " & Err.Description, vbCritical If Not auditWb Is Nothing Then auditWb.Close False Application.ScreenUpdating = True End Sub ' Function to sanitize folder names Private Function SanitizeFolderName(folderName As String) As String Dim invalidChars As Variant invalidChars = Array("\", "/", ":", "*", "?", """", "<", ">", "|") Dim i As Long For i = LBound(invalidChars) To UBound(invalidChars) folderName = Replace(folderName, invalidChars(i), "_") Next i SanitizeFolderName = folderName End Function