Stop spending hours manually consolidating Excel reports. This expert-level lesson walks you through building a production-grade VBA engine that opens hundreds of workbooks, validates schemas, transforms messy data into a canonical format, and writes a complete audit trail — automatically. Every architectural decision is explained so you can adapt the system to your real-world data.

Picture this: every Monday morning, your inbox fills up with 150 regional sales reports. Each file follows roughly the same template — roughly being the operative word. Some branches spell the column headers differently. A few use local date formats. One office decided to add three extra columns nobody asked for. Your job is to consolidate everything into a single master dataset before the 9 AM leadership meeting. You've been doing it by hand, and it takes two hours of copy-paste misery every single week.
This lesson is the engineering solution to that problem. We're going to build a production-grade VBA consolidation engine from scratch — a system that opens every workbook in a target folder, validates its structure, transforms the data into a canonical format, appends it to a master sheet, writes a detailed audit log of every decision made, and then cleans up after itself without leaving orphaned processes or corrupted files. This isn't a "record a macro and clean it up" situation. We're writing real software architecture in VBA, thinking carefully about error handling, performance, and maintainability.
By the end of this lesson, you'll have a working engine you can drop into any consolidation scenario with minimal configuration changes. More importantly, you'll understand why every design decision was made, so you can adapt the system intelligently when your real-world data refuses to cooperate.
What you'll learn:
You should be comfortable with:
On Error GoToYou don't need prior experience with multi-workbook automation, but you should understand that ThisWorkbook refers to the workbook containing the VBA code, while ActiveWorkbook is whichever workbook currently has focus — a distinction that will matter enormously here.
The single biggest mistake developers make with VBA consolidation scripts is writing everything in one 400-line Sub. It works until the day it doesn't, and then debugging it is archaeology. We're going to enforce a clean architecture from the start.
Our engine will consist of four logical layers:
1. Configuration Module (mod_Config) — All user-facing settings live here. Folder paths, expected column names, transformation rules, output sheet names. When requirements change, this is the only file someone needs to touch.
2. Orchestrator (mod_Orchestrator) — The conductor. It calls the other modules in sequence, manages the file loop, and handles top-level error recovery. It never manipulates data directly.
3. Transformer (mod_Transformer) — All data transformation logic. Date normalization, numeric cleaning, text standardization. Pure functions where possible — input goes in, clean output comes out.
4. Audit Logger (mod_Audit) — Every event gets written here. File opened, rows processed, rows rejected, errors caught. This module writes to a dedicated "Audit" worksheet in the master workbook.
This separation means you can test the transformer in isolation, swap out the configuration without touching the orchestrator, and read the audit log to understand exactly what the engine did on any given run.
Insert four standard modules into your master workbook (right-click the project in the VBA editor, Insert > Module) and rename them accordingly in the Properties window.
The configuration module is deceptively simple but critically important. Centralizing your settings here means the difference between a script that requires a developer to modify and one that a power user can configure.
' ============================================================
' mod_Config — All user-configurable settings
' ============================================================
Option Explicit
' --- Path Settings ---
Public Const SOURCE_FOLDER As String = "C:\Reports\Weekly\Incoming\"
Public Const MASTER_SHEET_NAME As String = "ConsolidatedData"
Public Const AUDIT_SHEET_NAME As String = "AuditLog"
Public Const ARCHIVE_FOLDER As String = "C:\Reports\Weekly\Processed\"
Public Const FILE_PATTERN As String = "*.xlsx"
' --- Schema Definition ---
' The canonical column order in the master sheet.
' Source files must contain ALL of these headers (exact match after normalization).
Public Function GetCanonicalSchema() As String()
Dim schema(0 To 8) As String
schema(0) = "RegionCode"
schema(1) = "BranchID"
schema(2) = "SaleDate"
schema(3) = "ProductSKU"
schema(4) = "Quantity"
schema(5) = "UnitPrice"
schema(6) = "SalesRepID"
schema(7) = "CustomerID"
schema(8) = "Notes"
GetCanonicalSchema = schema
End Function
' --- Column Aliases ---
' Maps alternate header names found in source files to canonical names.
' Key = what the source might say, Value = canonical name.
Public Function GetColumnAliases() As Object
Dim aliases As Object
Set aliases = CreateObject("Scripting.Dictionary")
aliases.CompareMode = 1 ' vbTextCompare — case insensitive
aliases("Region") = "RegionCode"
aliases("Region Code") = "RegionCode"
aliases("Branch") = "BranchID"
aliases("Branch ID") = "BranchID"
aliases("Branch Id") = "BranchID"
aliases("Date") = "SaleDate"
aliases("Sale Date") = "SaleDate"
aliases("Transaction Date") = "SaleDate"
aliases("SKU") = "ProductSKU"
aliases("Product") = "ProductSKU"
aliases("Product SKU") = "ProductSKU"
aliases("Qty") = "Quantity"
aliases("Units") = "Quantity"
aliases("Price") = "UnitPrice"
aliases("Unit Price") = "UnitPrice"
aliases("Rep") = "SalesRepID"
aliases("Sales Rep") = "SalesRepID"
aliases("Sales Rep ID") = "SalesRepID"
aliases("Customer") = "CustomerID"
aliases("Customer ID") = "CustomerID"
aliases("Comment") = "Notes"
aliases("Comments") = "Notes"
Set GetColumnAliases = aliases
End Function
' --- Transformation Rules ---
Public Const DATE_OUTPUT_FORMAT As String = "YYYY-MM-DD"
Public Const NUMERIC_DECIMAL_CHAR As String = "." ' What decimals should look like after cleaning
Public Const MAX_NOTES_LENGTH As Integer = 500
Public Const REJECT_BLANK_KEY_COLS As Boolean = True ' Reject rows where RegionCode or BranchID are blank
Notice that GetCanonicalSchema returns an array and GetColumnAliases returns a Scripting.Dictionary. The Dictionary is the right tool here because it gives us O(1) lookup when we're checking whether a source column header resolves to a canonical name. We're using CompareMode = 1 (text comparison) so "SKU" and "sku" map to the same thing.
Design decision: Why not store aliases in a worksheet instead of code? You could, and for very large alias tables it makes sense. But for a schema of under 20 columns, keeping aliases in code means your engine is a single
.xlsmfile with no external dependencies. That's a significant operational advantage.
We build the audit logger before the orchestrator because the orchestrator needs to call it from its very first action. Writing your logging infrastructure first also forces you to think about what events matter before you're deep in the weeds of the main logic.
' ============================================================
' mod_Audit — Structured audit logging to the AuditLog sheet
' ============================================================
Option Explicit
Private m_AuditSheet As Worksheet
Private m_RunID As String
Private m_RunStartTime As Date
Private m_NextAuditRow As Long
Public Sub InitializeAuditLog()
Dim ws As Worksheet
' Create or clear the audit sheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(AUDIT_SHEET_NAME)
On Error GoTo 0
If ws Is Nothing Then
Set ws = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
ws.Name = AUDIT_SHEET_NAME
End If
ws.Cells.Clear
' Write header row
With ws
.Cells(1, 1).Value = "RunID"
.Cells(1, 2).Value = "Timestamp"
.Cells(1, 3).Value = "FileName"
.Cells(1, 4).Value = "EventType"
.Cells(1, 5).Value = "RowNumber"
.Cells(1, 6).Value = "ColumnName"
.Cells(1, 7).Value = "OriginalValue"
.Cells(1, 8).Value = "TransformedValue"
.Cells(1, 9).Value = "Message"
.Rows(1).Font.Bold = True
End With
' Generate a unique RunID using timestamp
m_RunStartTime = Now()
m_RunID = "RUN_" & Format(m_RunStartTime, "YYYYMMDD_HHMMSS")
m_NextAuditRow = 2
Set m_AuditSheet = ws
' Log the run start event
WriteAuditEntry _
fileName:="[SYSTEM]", _
eventType:="RUN_START", _
rowNumber:=0, _
colName:="", _
originalVal:="", _
transformedVal:="", _
message:="Consolidation engine started. Source folder: " & SOURCE_FOLDER
End Sub
Public Sub WriteAuditEntry( _
fileName As String, _
eventType As String, _
rowNumber As Long, _
colName As String, _
originalVal As String, _
transformedVal As String, _
message As String)
If m_AuditSheet Is Nothing Then Exit Sub
With m_AuditSheet
.Cells(m_NextAuditRow, 1).Value = m_RunID
.Cells(m_NextAuditRow, 2).Value = Now()
.Cells(m_NextAuditRow, 2).NumberFormat = "YYYY-MM-DD HH:MM:SS"
.Cells(m_NextAuditRow, 3).Value = fileName
.Cells(m_NextAuditRow, 4).Value = eventType
.Cells(m_NextAuditRow, 5).Value = IIf(rowNumber > 0, rowNumber, "")
.Cells(m_NextAuditRow, 6).Value = colName
.Cells(m_NextAuditRow, 7).Value = Left(originalVal, 255)
.Cells(m_NextAuditRow, 8).Value = Left(transformedVal, 255)
.Cells(m_NextAuditRow, 9).Value = Left(message, 500)
End With
m_NextAuditRow = m_NextAuditRow + 1
End Sub
Public Sub FinalizeAuditLog(totalFiles As Long, totalRowsAccepted As Long, totalRowsRejected As Long)
WriteAuditEntry _
fileName:="[SYSTEM]", _
eventType:="RUN_COMPLETE", _
rowNumber:=0, _
colName:="", _
originalVal:="", _
transformedVal:="", _
message:="Run complete. Files: " & totalFiles & _
" | Rows accepted: " & totalRowsAccepted & _
" | Rows rejected: " & totalRowsRejected & _
" | Duration: " & Format(Now() - m_RunStartTime, "HH:MM:SS")
' Auto-fit the audit sheet columns for readability
m_AuditSheet.Columns("A:I").AutoFit
End Sub
The EventType column is the heart of a good audit log. We'll use a vocabulary of event types throughout the engine: RUN_START, RUN_COMPLETE, FILE_OPENED, FILE_SKIPPED, SCHEMA_ERROR, ROW_ACCEPTED, ROW_REJECTED, TRANSFORM_APPLIED, FILE_ARCHIVED, and ERROR. This gives you something you can filter and pivot on after the run.
Warning: Do not log every single cell transformation if you're processing hundreds of thousands of rows. The audit sheet will become a performance bottleneck. Log at the row level for rejections, and only log individual cell transformations for non-trivial changes (date reformatting, value coercion). We'll implement this selectively in the transformer.
The transformer is where the real intellectual work happens. We need to handle three categories of transformation:
' ============================================================
' mod_Transformer — Data transformation and validation logic
' ============================================================
Option Explicit
' --- Column mapping result structure (simulated with parallel arrays) ---
' We'll use a simple type to hold the column map for a given source file
Public Type ColumnMap
IsValid As Boolean
MissingColumns As String ' Comma-separated list of missing canonical columns
SourceColIndex As Variant ' Array: SourceColIndex(i) = the 1-based column index
' in the source sheet for canonical column i
' -1 means column not found
End Type
' -------------------------------------------------------
' BuildColumnMap
' Given a source worksheet, build a mapping from canonical
' column positions to source column positions.
' -------------------------------------------------------
Public Function BuildColumnMap(sourceSheet As Worksheet) As ColumnMap
Dim schema() As String
Dim aliases As Object
Dim result As ColumnMap
Dim headerRow As Long
Dim lastCol As Long
Dim i As Long, j As Long
Dim cellVal As String
Dim canonicalName As String
schema = GetCanonicalSchema()
Set aliases = GetColumnAliases()
' Find the header row (scan first 5 rows)
headerRow = FindHeaderRow(sourceSheet)
If headerRow = 0 Then
result.IsValid = False
result.MissingColumns = "Could not locate header row in first 5 rows"
BuildColumnMap = result
Exit Function
End If
lastCol = sourceSheet.Cells(headerRow, sourceSheet.Columns.Count).End(xlToLeft).Column
' Initialize source index array to -1 (not found)
ReDim result.SourceColIndex(0 To UBound(schema))
For i = 0 To UBound(schema)
result.SourceColIndex(i) = -1
Next i
' Build a dictionary of header -> source column index from the source file
Dim sourceHeaders As Object
Set sourceHeaders = CreateObject("Scripting.Dictionary")
sourceHeaders.CompareMode = 1 ' case insensitive
For j = 1 To lastCol
cellVal = Trim(sourceSheet.Cells(headerRow, j).Value)
If cellVal <> "" Then
sourceHeaders(cellVal) = j
End If
Next j
' Match source headers to canonical schema
Dim missing As String
missing = ""
For i = 0 To UBound(schema)
canonicalName = schema(i)
' Direct match first
If sourceHeaders.Exists(canonicalName) Then
result.SourceColIndex(i) = sourceHeaders(canonicalName)
ElseIf aliases.Exists(canonicalName) Then
' This shouldn't happen — aliases map source->canonical, not canonical->source
' We need to search the alias dictionary differently
result.SourceColIndex(i) = -1
Else
result.SourceColIndex(i) = -1
End If
' If not found by direct match, check aliases
If result.SourceColIndex(i) = -1 Then
Dim srcHeader As Variant
For Each srcHeader In sourceHeaders.Keys
If aliases.Exists(CStr(srcHeader)) Then
If aliases(CStr(srcHeader)) = canonicalName Then
result.SourceColIndex(i) = sourceHeaders(srcHeader)
Exit For
End If
End If
Next srcHeader
End If
' Still not found? It's missing.
If result.SourceColIndex(i) = -1 Then
If missing = "" Then
missing = canonicalName
Else
missing = missing & ", " & canonicalName
End If
End If
Next i
result.MissingColumns = missing
result.IsValid = (missing = "")
BuildColumnMap = result
End Function
' -------------------------------------------------------
' FindHeaderRow
' Looks for the row containing the most recognized column
' headers, within the first 5 rows of the sheet.
' -------------------------------------------------------
Private Function FindHeaderRow(ws As Worksheet) As Long
Dim aliases As Object
Dim schema() As String
Dim r As Long, c As Long
Dim bestRow As Long
Dim bestScore As Long
Dim score As Long
Dim cellVal As String
Dim lastCol As Long
Set aliases = GetColumnAliases()
schema = GetCanonicalSchema()
bestRow = 0
bestScore = 0
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
For r = 1 To 5
score = 0
For c = 1 To lastCol
cellVal = Trim(ws.Cells(r, c).Value)
If cellVal <> "" Then
' Check if it's a direct schema match or an alias
Dim s As Long
For s = 0 To UBound(schema)
If LCase(cellVal) = LCase(schema(s)) Then
score = score + 1
Exit For
End If
Next s
If aliases.Exists(cellVal) Then score = score + 1
End If
Next c
If score > bestScore Then
bestScore = score
bestRow = r
End If
Next r
' Require at least 3 recognized headers to claim a row is the header row
If bestScore < 3 Then bestRow = 0
FindHeaderRow = bestRow
End Function
' -------------------------------------------------------
' CleanDate
' Attempts to parse a cell value as a date and returns
' a string in the canonical format, or "" if unparseable.
' -------------------------------------------------------
Public Function CleanDate(rawValue As Variant) As String
Dim d As Date
If IsEmpty(rawValue) Or rawValue = "" Then
CleanDate = ""
Exit Function
End If
' If Excel already stored it as a date serial
If IsDate(rawValue) Then
d = CDate(rawValue)
CleanDate = Format(d, DATE_OUTPUT_FORMAT)
Exit Function
End If
' Try parsing common string date formats
Dim strVal As String
strVal = Trim(CStr(rawValue))
' Replace slashes and dots with hyphens for uniform parsing
strVal = Replace(strVal, "/", "-")
strVal = Replace(strVal, ".", "-")
On Error Resume Next
d = CDate(strVal)
If Err.Number = 0 Then
CleanDate = Format(d, DATE_OUTPUT_FORMAT)
Else
CleanDate = ""
End If
On Error GoTo 0
End Function
' -------------------------------------------------------
' CleanNumeric
' Returns a Double from a cell value, handling currency
' symbols, thousands separators, and European decimal commas.
' Returns 0 and sets wasValid=False if unparseable.
' -------------------------------------------------------
Public Function CleanNumeric(rawValue As Variant, ByRef wasValid As Boolean) As Double
wasValid = True
If IsEmpty(rawValue) Or rawValue = "" Then
wasValid = False
CleanNumeric = 0
Exit Function
End If
If IsNumeric(rawValue) Then
CleanNumeric = CDbl(rawValue)
Exit Function
End If
' Strip common non-numeric characters
Dim strVal As String
strVal = Trim(CStr(rawValue))
strVal = Replace(strVal, "$", "")
strVal = Replace(strVal, "€", "")
strVal = Replace(strVal, "£", "")
strVal = Replace(strVal, ",", "") ' Remove thousands separators (US format)
strVal = Replace(strVal, " ", "")
' Handle European decimal comma (1.234,56 -> 1234.56)
' Heuristic: if there's a period before a comma, it's European
If InStr(strVal, ".") > 0 And InStr(strVal, ",") > 0 Then
If InStr(strVal, ".") < InStr(strVal, ",") Then
strVal = Replace(strVal, ".", "")
strVal = Replace(strVal, ",", ".")
End If
End If
If IsNumeric(strVal) Then
CleanNumeric = CDbl(strVal)
Else
wasValid = False
CleanNumeric = 0
End If
End Function
' -------------------------------------------------------
' CleanText
' Trims whitespace, normalizes internal spaces, and
' truncates to maxLength.
' -------------------------------------------------------
Public Function CleanText(rawValue As Variant, maxLength As Integer) As String
If IsEmpty(rawValue) Or IsNull(rawValue) Then
CleanText = ""
Exit Function
End If
Dim s As String
s = Trim(CStr(rawValue))
' Collapse multiple internal spaces
Do While InStr(s, " ") > 0
s = Replace(s, " ", " ")
Loop
' Remove non-printable characters
Dim i As Integer
Dim cleaned As String
cleaned = ""
For i = 1 To Len(s)
If Asc(Mid(s, i, 1)) >= 32 Then
cleaned = cleaned & Mid(s, i, 1)
End If
Next i
If Len(cleaned) > maxLength Then
CleanText = Left(cleaned, maxLength)
Else
CleanText = cleaned
End If
End Function
The FindHeaderRow function deserves special attention. Instead of assuming the header is always in row 1, we score the first five rows based on how many recognized column names they contain. This handles the extremely common case where source files have a report title or company logo in row 1 and the actual data starts in row 2 or 3.
Edge case to watch: The
CleanNumericEuropean comma heuristic — treating "1.234,56" as 1234.56 — is a reasonable heuristic but not foolproof. If your data comes from a single locale, disable the alternative path. If it comes from multiple locales, consider adding a source-file-level locale flag to the configuration.
The orchestrator is the engine block. It initializes the system, iterates through files, delegates to the transformer, and manages state across the entire run.
' ============================================================
' mod_Orchestrator — Main engine controller
' ============================================================
Option Explicit
' Run-level counters
Private m_TotalFiles As Long
Private m_TotalAccepted As Long
Private m_TotalRejected As Long
Private m_MasterNextRow As Long
' -------------------------------------------------------
' RunConsolidation — The single public entry point.
' Call this from a button or from the Immediate window.
' -------------------------------------------------------
Public Sub RunConsolidation()
' Disable screen and event interference
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
On Error GoTo Cleanup
' Initialize systems
Call InitializeAuditLog
m_TotalFiles = 0
m_TotalAccepted = 0
m_TotalRejected = 0
' Prepare master sheet
Dim masterSheet As Worksheet
Set masterSheet = PrepareOrGetMasterSheet()
m_MasterNextRow = GetNextEmptyRow(masterSheet)
' If master sheet is empty (new run), write headers
If m_MasterNextRow = 1 Then
WriteCanonicalHeaders masterSheet
m_MasterNextRow = 2
End If
' Enumerate source files
Dim fileName As String
Dim filePath As String
fileName = Dir(SOURCE_FOLDER & FILE_PATTERN)
Do While fileName <> ""
filePath = SOURCE_FOLDER & fileName
' Skip the master workbook itself (safety check)
If LCase(filePath) <> LCase(ThisWorkbook.FullName) Then
ProcessSingleFile filePath, fileName, masterSheet
m_TotalFiles = m_TotalFiles + 1
End If
fileName = Dir()
Loop
Call FinalizeAuditLog(m_TotalFiles, m_TotalAccepted, m_TotalRejected)
Cleanup:
If Err.Number <> 0 Then
WriteAuditEntry "[SYSTEM]", "ERROR", 0, "", "", "", _
"Fatal error in orchestrator: " & Err.Description & " (Error " & Err.Number & ")"
End If
' Always restore Excel state
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
If Err.Number = 0 Then
MsgBox "Consolidation complete!" & vbCrLf & _
"Files processed: " & m_TotalFiles & vbCrLf & _
"Rows accepted: " & m_TotalAccepted & vbCrLf & _
"Rows rejected: " & m_TotalRejected, _
vbInformation, "Consolidation Engine"
End If
End Sub
' -------------------------------------------------------
' ProcessSingleFile
' Opens one source workbook, validates schema, transforms
' and appends data, then closes and optionally archives.
' -------------------------------------------------------
Private Sub ProcessSingleFile(filePath As String, fileName As String, masterSheet As Worksheet)
Dim srcWB As Workbook
Dim srcSheet As Worksheet
Dim colMap As ColumnMap
Dim schema() As String
Dim headerRow As Long
Dim lastDataRow As Long
Dim r As Long
On Error GoTo FileError
' Open without running macros, without updating links
Set srcWB = Workbooks.Open( _
Filename:=filePath, _
UpdateLinks:=False, _
ReadOnly:=True, _
AddToMRU:=False, _
CorruptLoad:=xlNormalLoad)
WriteAuditEntry fileName, "FILE_OPENED", 0, "", "", "", _
"Opened successfully. Sheets: " & srcWB.Worksheets.Count
' Use the first visible sheet
Set srcSheet = GetFirstVisibleSheet(srcWB)
If srcSheet Is Nothing Then
WriteAuditEntry fileName, "FILE_SKIPPED", 0, "", "", "", "No visible worksheets found"
srcWB.Close SaveChanges:=False
Exit Sub
End If
' Validate schema
colMap = BuildColumnMap(srcSheet)
schema = GetCanonicalSchema()
If Not colMap.IsValid Then
WriteAuditEntry fileName, "SCHEMA_ERROR", 0, "", "", "", _
"Missing required columns: " & colMap.MissingColumns
srcWB.Close SaveChanges:=False
Exit Sub
End If
' Find header row and data extent
headerRow = FindHeaderRow(srcSheet)
lastDataRow = srcSheet.Cells(srcSheet.Rows.Count, colMap.SourceColIndex(0)).End(xlUp).Row
If lastDataRow <= headerRow Then
WriteAuditEntry fileName, "FILE_SKIPPED", 0, "", "", "", "No data rows found below header row " & headerRow
srcWB.Close SaveChanges:=False
Exit Sub
End If
' Process each data row
Dim rowsAccepted As Long
Dim rowsRejected As Long
rowsAccepted = 0
rowsRejected = 0
For r = headerRow + 1 To lastDataRow
Dim accepted As Boolean
accepted = TransformAndAppendRow( _
srcSheet, r, colMap, schema, masterSheet, fileName)
If accepted Then
rowsAccepted = rowsAccepted + 1
m_TotalAccepted = m_TotalAccepted + 1
m_MasterNextRow = m_MasterNextRow + 1
Else
rowsRejected = rowsRejected + 1
m_TotalRejected = m_TotalRejected + 1
End If
Next r
WriteAuditEntry fileName, "FILE_PROCESSED", 0, "", "", "", _
"Rows accepted: " & rowsAccepted & " | Rows rejected: " & rowsRejected
srcWB.Close SaveChanges:=False
' Move to archive folder
ArchiveFile filePath, fileName
Exit Sub
FileError:
WriteAuditEntry fileName, "ERROR", 0, "", "", "", _
"Error processing file: " & Err.Description & " (Error " & Err.Number & ")"
On Error Resume Next
If Not srcWB Is Nothing Then srcWB.Close SaveChanges:=False
On Error GoTo 0
Err.Clear
End Sub
' -------------------------------------------------------
' TransformAndAppendRow
' Transforms a single source row and writes it to master.
' Returns True if row was accepted, False if rejected.
' -------------------------------------------------------
Private Function TransformAndAppendRow( _
srcSheet As Worksheet, _
srcRow As Long, _
colMap As ColumnMap, _
schema() As String, _
masterSheet As Worksheet, _
fileName As String) As Boolean
Dim i As Long
Dim rawVal As Variant
Dim cleanVal As Variant
Dim outputRow() As Variant
ReDim outputRow(0 To UBound(schema))
Dim rejected As Boolean
Dim rejectReason As String
rejected = False
' Add source file tracking column (write to schema+1 position)
' We'll also store the source file name for provenance
For i = 0 To UBound(schema)
Dim srcColIdx As Long
srcColIdx = colMap.SourceColIndex(i)
If srcColIdx > 0 Then
rawVal = srcSheet.Cells(srcRow, srcColIdx).Value
Else
rawVal = ""
End If
' Apply transformation based on canonical column name
Select Case schema(i)
Case "RegionCode", "BranchID", "SalesRepID", "CustomerID", "ProductSKU"
cleanVal = CleanText(rawVal, 50)
' Business rule: key identifier columns cannot be blank
If REJECT_BLANK_KEY_COLS And cleanVal = "" Then
rejected = True
rejectReason = schema(i) & " is blank"
End If
Case "SaleDate"
Dim originalDate As String
originalDate = CStr(rawVal)
cleanVal = CleanDate(rawVal)
If cleanVal = "" Then
rejected = True
rejectReason = "SaleDate could not be parsed: '" & originalDate & "'"
ElseIf cleanVal <> originalDate And originalDate <> "" Then
WriteAuditEntry fileName, "TRANSFORM_APPLIED", srcRow, "SaleDate", _
originalDate, cleanVal, "Date normalized"
End If
Case "Quantity"
Dim qtyValid As Boolean
Dim qtyRaw As String
qtyRaw = CStr(rawVal)
cleanVal = CleanNumeric(rawVal, qtyValid)
If Not qtyValid Then
rejected = True
rejectReason = "Quantity is not numeric: '" & qtyRaw & "'"
ElseIf CDbl(cleanVal) < 0 Then
rejected = True
rejectReason = "Quantity is negative: " & cleanVal
End If
Case "UnitPrice"
Dim priceValid As Boolean
Dim priceRaw As String
priceRaw = CStr(rawVal)
cleanVal = CleanNumeric(rawVal, priceValid)
If Not priceValid Then
rejected = True
rejectReason = "UnitPrice is not numeric: '" & priceRaw & "'"
End If
Case "Notes"
cleanVal = CleanText(rawVal, MAX_NOTES_LENGTH)
Case Else
cleanVal = CleanText(rawVal, 255)
End Select
If rejected Then Exit For
outputRow(i) = cleanVal
Next i
If rejected Then
WriteAuditEntry fileName, "ROW_REJECTED", srcRow, "", "", "", rejectReason
TransformAndAppendRow = False
Exit Function
End If
' Write the transformed row to the master sheet
Dim col As Long
For col = 0 To UBound(schema)
masterSheet.Cells(m_MasterNextRow, col + 1).Value = outputRow(col)
Next col
' Write provenance: source file name in last column
masterSheet.Cells(m_MasterNextRow, UBound(schema) + 2).Value = fileName
TransformAndAppendRow = True
End Function
' -------------------------------------------------------
' Helper Functions
' -------------------------------------------------------
Private Function PrepareOrGetMasterSheet() As Worksheet
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(MASTER_SHEET_NAME)
On Error GoTo 0
If ws Is Nothing Then
Set ws = ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Worksheets(1))
ws.Name = MASTER_SHEET_NAME
End If
Set PrepareOrGetMasterSheet = ws
End Function
Private Function GetNextEmptyRow(ws As Worksheet) As Long
If ws.Cells(1, 1).Value = "" Then
GetNextEmptyRow = 1
Else
GetNextEmptyRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
End If
End Function
Private Sub WriteCanonicalHeaders(masterSheet As Worksheet)
Dim schema() As String
schema = GetCanonicalSchema()
Dim i As Long
For i = 0 To UBound(schema)
masterSheet.Cells(1, i + 1).Value = schema(i)
Next i
masterSheet.Cells(1, UBound(schema) + 2).Value = "SourceFile"
masterSheet.Rows(1).Font.Bold = True
m_MasterNextRow = 2
End Sub
Private Function GetFirstVisibleSheet(wb As Workbook) As Worksheet
Dim ws As Worksheet
For Each ws In wb.Worksheets
If ws.Visible = xlSheetVisible Then
Set GetFirstVisibleSheet = ws
Exit Function
End If
Next ws
Set GetFirstVisibleSheet = Nothing
End Function
Private Sub ArchiveFile(filePath As String, fileName As String)
On Error Resume Next
' Create archive folder if it doesn't exist
If Dir(ARCHIVE_FOLDER, vbDirectory) = "" Then
MkDir ARCHIVE_FOLDER
End If
' Move the file (Name statement = rename/move in VBA)
Dim destPath As String
destPath = ARCHIVE_FOLDER & fileName
' If a file with the same name already exists in archive, timestamp it
If Dir(destPath) <> "" Then
Dim ext As String
Dim baseName As String
ext = "." & Split(fileName, ".")(UBound(Split(fileName, ".")))
baseName = Left(fileName, Len(fileName) - Len(ext))
destPath = ARCHIVE_FOLDER & baseName & "_" & Format(Now(), "YYYYMMDD_HHMMSS") & ext
End If
Name filePath As destPath
If Err.Number = 0 Then
WriteAuditEntry fileName, "FILE_ARCHIVED", 0, "", "", "", "Moved to: " & destPath
Else
WriteAuditEntry fileName, "ERROR", 0, "", "", "", _
"Could not archive file: " & Err.Description
Err.Clear
End If
On Error GoTo 0
End Sub
Notice we call FindHeaderRow in the orchestrator (implicitly, through BuildColumnMap) rather than exposing it publicly. The orchestrator knows to call FindHeaderRow again to get the actual header row number for the data iteration loop — this is a slight inefficiency but keeps the API clean. For very large files, you could cache the header row in the ColumnMap type.
Critical performance note: We open each source workbook with
ReadOnly:=True,UpdateLinks:=False, andAddToMRU:=False. These three parameters are not optional niceties — they're the difference between a 2-second file open and a 30-second file open, especially on network shares.AddToMRU:=Falseprevents polluting the user's recent files list with 150 temporary source files.
If your source files contain more than a few thousand rows each, the cell-by-cell reading in the current TransformAndAppendRow approach will be too slow. Each srcSheet.Cells(r, c).Value call crosses the VBA-to-Excel object model boundary. For a 10,000-row file with 9 columns, that's 90,000 COM calls per file. At 100 files, you're making 9 million COM calls.
The solution is to read the entire data range into a Variant array once, process it in memory, and write the results to the master sheet in a single bulk write.
Here's the optimized version of the data-processing loop you would add to the orchestrator:
' -------------------------------------------------------
' ProcessSheetWithArrays
' High-performance version using bulk array read/write.
' Replaces the row-by-row loop for large files.
' -------------------------------------------------------
Private Sub ProcessSheetWithArrays( _
srcSheet As Worksheet, _
headerRow As Long, _
lastDataRow As Long, _
colMap As ColumnMap, _
schema() As String, _
masterSheet As Worksheet, _
fileName As String, _
ByRef rowsAccepted As Long, _
ByRef rowsRejected As Long)
Dim lastSrcCol As Long
Dim totalRows As Long
Dim srcData As Variant
Dim outputBuf() As Variant
Dim outRow As Long
Dim i As Long, r As Long
lastSrcCol = srcSheet.Cells(headerRow, srcSheet.Columns.Count).End(xlToLeft).Column
totalRows = lastDataRow - headerRow ' Number of data rows (excluding header)
' Read entire data block into a 2D array in one shot
srcData = srcSheet.Range( _
srcSheet.Cells(headerRow + 1, 1), _
srcSheet.Cells(lastDataRow, lastSrcCol)).Value
' Pre-allocate output buffer (rows x canonical columns + 1 for SourceFile)
ReDim outputBuf(1 To totalRows, 1 To UBound(schema) + 2)
outRow = 0
For r = 1 To totalRows
Dim rejected As Boolean
Dim rejectReason As String
rejected = False
Dim rowData() As Variant
ReDim rowData(0 To UBound(schema))
For i = 0 To UBound(schema)
Dim srcIdx As Long
srcIdx = colMap.SourceColIndex(i)
Dim rawVal As Variant
If srcIdx > 0 And srcIdx <= UBound(srcData, 2) Then
rawVal = srcData(r, srcIdx)
Else
rawVal = ""
End If
' Apply transformations (same logic as before, abbreviated here)
Select Case schema(i)
Case "SaleDate"
Dim dVal As String
dVal = CleanDate(rawVal)
If dVal = "" And Not (IsEmpty(rawVal) Or rawVal = "") Then
rejected = True
rejectReason = "SaleDate unparseable: " & CStr(rawVal)
End If
rowData(i) = dVal
Case "Quantity", "UnitPrice"
Dim numValid As Boolean
Dim numVal As Double
numVal = CleanNumeric(rawVal, numValid)
If Not numValid And Not (IsEmpty(rawVal) Or rawVal = "") Then
rejected = True
rejectReason = schema(i) & " not numeric: " & CStr(rawVal)
End If
rowData(i) = numVal
Case "RegionCode", "BranchID"
Dim txtVal As String
txtVal = CleanText(rawVal, 50)
If REJECT_BLANK_KEY_COLS And txtVal = "" Then
rejected = True
rejectReason = schema(i) & " is blank"
End If
rowData(i) = txtVal
Case Else
rowData(i) = CleanText(rawVal, 255)
End Select
If rejected Then Exit For
Next i
If rejected Then
rowsRejected = rowsRejected + 1
m_TotalRejected = m_TotalRejected + 1
WriteAuditEntry fileName, "ROW_REJECTED", r + headerRow, "", "", "", rejectReason
Else
outRow = outRow + 1
For i = 0 To UBound(schema)
outputBuf(outRow, i + 1) = rowData(i)
Next i
outputBuf(outRow, UBound(schema) + 2) = fileName
rowsAccepted = rowsAccepted + 1
m_TotalAccepted = m_TotalAccepted + 1
End If
Next r
' Bulk write accepted rows to master sheet in one operation
If outRow > 0 Then
masterSheet.Range( _
masterSheet.Cells(m_MasterNextRow, 1), _
masterSheet.Cells(m_MasterNextRow + outRow - 1, UBound(schema) + 2) _
).Value = outputBuf
' Trim the buffer to actual output rows before writing
' (We allocated totalRows but may have written fewer due to rejections)
' The above write will include blank rows if rejections occurred.
' For production, resize the array to outRow before writing.
m_MasterNextRow = m_MasterNextRow + outRow
End If
End Sub
The performance difference is dramatic. Reading 5,000 rows × 9 columns as a single array read takes roughly the same time as reading a single cell. Bulk writing the output in one Range.Value assignment is similarly fast. On typical hardware, this approach processes files at roughly 50,000–100,000 rows per second, versus 500–1,000 rows per second with the cell-by-cell approach.
Warning about the output buffer: The code above writes
outputBufwhich was allocated withtotalRowsrows, but onlyoutRowrows were filled. The unfilled rows will be written as zeros/empty strings. In production, use aReDim Preserve outputBuf(1 To outRow, ...)before the final write, or write only the filled portion using a dynamic range calculation.
Now you'll build and test the engine end-to-end using generated test data.
Setup (15 minutes):
Create a new workbook called ConsolidationEngine.xlsm. Add four modules as described earlier and paste the code for each module.
Create a folder at C:\Reports\Weekly\Incoming\ and a subfolder at C:\Reports\Weekly\Processed\.
Create five test source workbooks. Three should follow the "canonical" format exactly. One should use alternate column names (e.g., "Date" instead of "SaleDate", "Qty" instead of "Quantity"). One should have intentional data quality issues: a blank BranchID in row 5, a non-numeric Quantity in row 8, and a corrupted date in row 12.
Test Run (10 minutes):
Open the VBA editor in ConsolidationEngine.xlsm, place your cursor inside RunConsolidation, and press F5 to run it.
Examine the ConsolidatedData sheet. Verify that the alias-mapped file was correctly included and the "SourceFile" column shows the originating filename for every row.
Examine the AuditLog sheet. Filter the EventType column to "ROW_REJECTED" and verify you see exactly three rejected rows from the problematic file, with clear rejection reasons.
Check the C:\Reports\Weekly\Processed\ folder — all five source files should have been moved there.
Stretch Goal (20 minutes):
Modify mod_Config to add a sixth canonical column called "TaxRegion" that does not appear in any of your test files. Run the engine. The schema validator should now reject all five files because they all lack "TaxRegion". Examine the audit log to confirm SCHEMA_ERROR events.
Add "TaxRegion" back only to two of the five source files. Add an alias mapping "Tax Region" for one of them. Run the engine again. Now only those two files should produce accepted rows. Confirm this in both the master sheet and the audit log.
"The engine opens files but finds no data rows."
This almost always means FindHeaderRow returned 0 or the wrong row, causing lastDataRow to be calculated incorrectly. Add a breakpoint in ProcessSingleFile after the BuildColumnMap call and inspect headerRow. If it's 0, your source file's header row doesn't contain at least 3 recognized column names — add more aliases to GetColumnAliases.
"Excel hangs or crashes mid-run."
Usually caused by a source file that's locked (open by another user), password-protected, or corrupt. The FileError label in ProcessSingleFile should catch this and log an ERROR event, then continue with the next file. If it's not recovering, check that On Error GoTo FileError is the very first line in ProcessSingleFile before any Dim statements.
"All rows are being rejected for blank RegionCode even though the data is there."
Inspect the column mapping. Use a watch on colMap.SourceColIndex(0) to see what source column index is being resolved for RegionCode. If it's -1, the alias resolution failed. Check GetColumnAliases — remember the CompareMode on the Dictionary is case-insensitive for the key lookup, but you must ensure the alias dictionary key matches what's in the source file header exactly (after trimming).
"The master sheet grows a new header row on every run instead of appending."
GetNextEmptyRow checks ws.Cells(1, 1).Value = "". If the master sheet header row was written with formatting but empty values (a common issue if the sheet was cleared incorrectly), this check will trigger and re-write headers. Always clear a sheet with ws.Cells.Clear rather than ws.Cells.ClearFormats or ws.UsedRange.Clear.
"Performance is unacceptably slow — 2 seconds per file."
Verify that Application.ScreenUpdating = False and Application.Calculation = xlCalculationManual are set before the file loop. If you're on a network share, file open time dominates — consider copying files to a local temp folder first. Also verify you're using the array-based approach for files with more than 500 rows.
"The archive operation throws an error with 'Path not found'."
The ARCHIVE_FOLDER path doesn't exist. The code includes a MkDir call, but MkDir only creates one level at a time. If the intermediate directories don't exist, it will fail. For deeply nested paths, implement a recursive directory creation helper.
Once the base engine is working, three extensions are worth building for production use:
Incremental processing with a manifest: Instead of moving processed files to an archive and relying on the folder being cleared, maintain a manifest sheet that records every file processed with its name, size, and last-modified timestamp. On subsequent runs, compare incoming files against the manifest and skip already-processed ones. This is safer than archiving because you preserve the source files.
Pre-run file scanning report: Before running the full consolidation, run a dry-run pass that opens each file, validates the schema, and writes a summary report showing which files will be accepted, which will fail schema validation, and why — all without writing any data to the master sheet. This gives operators a chance to fix source files before committing to the run.
Excel Table (ListObject) as the master container: Instead of writing to a plain range, write to a structured Excel Table. This gives you built-in filtering, automatic column expansion, and the ability to reference the data from Power Query or Power Pivot without needing to know the range address. Convert the target range to a Table with masterSheet.ListObjects.Add(xlSrcRange, ...) after writing the header row.
You've built a production-grade VBA consolidation engine from first principles. The architecture — configuration, orchestration, transformation, auditing — is the same pattern used in ETL systems regardless of the technology stack. You've implemented schema validation that handles real-world messiness (inconsistent column names, variable header row positions), a transformation pipeline that handles dates, numerics, and text across inconsistent source formats, and an audit log that gives you a forensic trail of every decision made during a run.
The key technical decisions to remember:
ReadOnly:=True, UpdateLinks:=False, and AddToMRU:=False for both performance and safetyRunID in the audit log so you can separate multiple runs without clearing the logScreenUpdating, EnableEvents, DisplayAlerts, and Calculation in a Cleanup block, even when errors occurWhere to go next:
ThisWorkbook.Connections.Item(...).RefreshThe consolidation problem is never fully solved — your sources will change, your schema will evolve, and edge cases will appear that nobody anticipated. The audit log is your most important output. Protect it, read it, and let it guide your next round of improvements.