Attribute VB_Name = "MultiSheetConsolidationModule"
Option Explicit

' MacroWise Course Deliverable
' Multi-sheet consolidation VBA automation module
' Compatible with Excel 2016+
'
' This macro can consolidate:
'   1. All worksheets in the current workbook, or
'   2. Multiple selected workbooks
'
' It handles different column orders by standardising header names and writing
' everything to a single "Master Consolidation" worksheet with source metadata.

Private Const MASTER_SHEET_NAME As String = "Master Consolidation"

Public Sub ConsolidateToMasterSheet()
    Dim response As VbMsgBoxResult
    Dim masterSheet As Worksheet
    Dim headerIndex As Object
    Dim nextRow As Long
    Dim importedSheets As Long
    Dim importedRows As Long

    On Error GoTo CleanFail

    response = MsgBox( _
        "Yes = consolidate all worksheets in this workbook" & vbCrLf & _
        "No = pick one or more workbooks to consolidate" & vbCrLf & _
        "Cancel = stop", _
        vbYesNoCancel + vbQuestion, "MacroWise")

    If response = vbCancel Then Exit Sub

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    Set masterSheet = PrepareMasterSheet(ThisWorkbook, MASTER_SHEET_NAME)
    Set headerIndex = CreateObject("Scripting.Dictionary")
    headerIndex.CompareMode = vbTextCompare

    SeedMasterHeaders masterSheet, headerIndex
    nextRow = 2

    If response = vbYes Then
        ConsolidateWorkbook ThisWorkbook, masterSheet, headerIndex, nextRow, importedSheets, importedRows
    Else
        ConsolidateSelectedWorkbooks masterSheet, headerIndex, nextRow, importedSheets, importedRows
    End If

    FormatMasterSheet masterSheet, nextRow - 1

    MsgBox importedRows & " row(s) imported from " & importedSheets & " worksheet(s)." & vbCrLf & _
           "Review the '" & MASTER_SHEET_NAME & "' sheet for the combined data.", _
           vbInformation, "MacroWise"

CleanExit:
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub

CleanFail:
    MsgBox "Consolidation stopped: " & Err.Description, vbCritical, "MacroWise"
    Resume CleanExit
End Sub

Private Sub ConsolidateSelectedWorkbooks(ByVal masterSheet As Worksheet, ByVal headerIndex As Object, _
                                         ByRef nextRow As Long, ByRef importedSheets As Long, ByRef importedRows As Long)
    Dim filePicker As FileDialog
    Dim selectedFile As Variant
    Dim sourceWorkbook As Workbook

    Set filePicker = Application.FileDialog(msoFileDialogFilePicker)

    With filePicker
        .AllowMultiSelect = True
        .Title = "Select workbooks to consolidate"
        .Filters.Clear
        .Filters.Add "Excel files", "*.xls; *.xlsx; *.xlsm; *.xlsb", 1

        If .Show <> -1 Then Exit Sub

        For Each selectedFile In .SelectedItems
            Set sourceWorkbook = Workbooks.Open(CStr(selectedFile), ReadOnly:=True)
            ConsolidateWorkbook sourceWorkbook, masterSheet, headerIndex, nextRow, importedSheets, importedRows
            sourceWorkbook.Close SaveChanges:=False
        Next selectedFile
    End With
End Sub

Private Sub ConsolidateWorkbook(ByVal sourceWorkbook As Workbook, ByVal masterSheet As Worksheet, ByVal headerIndex As Object, _
                                ByRef nextRow As Long, ByRef importedSheets As Long, ByRef importedRows As Long)
    Dim sourceSheet As Worksheet
    Dim headerMap As Object
    Dim headerRow As Long
    Dim lastRow As Long
    Dim lastCol As Long
    Dim rowIndex As Long
    Dim sourceColumn As Variant
    Dim targetColumn As Long

    For Each sourceSheet In sourceWorkbook.Worksheets
        If ShouldImportSheet(sourceSheet) Then
            headerRow = DetectHeaderRow(sourceSheet, 10)
            lastRow = LastUsedRow(sourceSheet)
            lastCol = LastUsedColumn(sourceSheet)

            If headerRow > 0 And lastRow > headerRow And lastCol > 0 Then
                Set headerMap = BuildHeaderMap(sourceSheet, headerRow, lastCol, masterSheet, headerIndex)
                importedSheets = importedSheets + 1

                For rowIndex = headerRow + 1 To lastRow
                    If RowHasData(sourceSheet, rowIndex, lastCol) Then
                        masterSheet.Cells(nextRow, 1).Value = sourceWorkbook.Name
                        masterSheet.Cells(nextRow, 2).Value = sourceSheet.Name
                        masterSheet.Cells(nextRow, 3).Value = rowIndex

                        For Each sourceColumn In headerMap.Keys
                            targetColumn = CLng(headerMap(sourceColumn))
                            masterSheet.Cells(nextRow, targetColumn).Value = sourceSheet.Cells(rowIndex, CLng(sourceColumn)).Value
                        Next sourceColumn

                        nextRow = nextRow + 1
                        importedRows = importedRows + 1
                    End If
                Next rowIndex
            End If
        End If
    Next sourceSheet
End Sub

Private Function BuildHeaderMap(ByVal sourceSheet As Worksheet, ByVal headerRow As Long, ByVal lastCol As Long, _
                                ByVal masterSheet As Worksheet, ByVal headerIndex As Object) As Object
    Dim headerMap As Object
    Dim sourceColumn As Long
    Dim rawHeader As String
    Dim canonicalHeader As String
    Dim targetColumn As Long

    Set headerMap = CreateObject("Scripting.Dictionary")
    headerMap.CompareMode = vbTextCompare

    For sourceColumn = 1 To lastCol
        rawHeader = Trim$(CStr(sourceSheet.Cells(headerRow, sourceColumn).Value))
        If Len(rawHeader) > 0 Then
            canonicalHeader = CanonicalHeader(rawHeader)
            targetColumn = EnsureMasterHeader(masterSheet, headerIndex, canonicalHeader)
            headerMap(CStr(sourceColumn)) = targetColumn
        End If
    Next sourceColumn

    Set BuildHeaderMap = headerMap
End Function

Private Sub SeedMasterHeaders(ByVal masterSheet As Worksheet, ByVal headerIndex As Object)
    headerIndex.Add "Source Workbook", 1
    headerIndex.Add "Source Worksheet", 2
    headerIndex.Add "Source Row", 3

    masterSheet.Cells(1, 1).Value = "Source Workbook"
    masterSheet.Cells(1, 2).Value = "Source Worksheet"
    masterSheet.Cells(1, 3).Value = "Source Row"
End Sub

Private Function EnsureMasterHeader(ByVal masterSheet As Worksheet, ByVal headerIndex As Object, ByVal headerName As String) As Long
    Dim nextColumn As Long

    If headerIndex.Exists(headerName) Then
        EnsureMasterHeader = CLng(headerIndex(headerName))
        Exit Function
    End If

    nextColumn = headerIndex.Count + 1
    headerIndex.Add headerName, nextColumn
    masterSheet.Cells(1, nextColumn).Value = headerName

    EnsureMasterHeader = nextColumn
End Function

Private Function CanonicalHeader(ByVal rawHeader As String) As String
    Dim normalized As String

    normalized = Trim$(LCase$(rawHeader))
    normalized = Replace(normalized, "_", " ")
    normalized = Replace(normalized, "-", " ")
    normalized = Replace(normalized, ".", " ")
    normalized = WorksheetFunction.Trim(normalized)

    Select Case normalized
        Case "dept", "department name"
            CanonicalHeader = "Department"
        Case "gl account", "account", "acct", "account number"
            CanonicalHeader = "Account"
        Case "date", "transaction date", "posting date", "effective date"
            CanonicalHeader = "Date"
        Case "amount", "net amount", "value"
            CanonicalHeader = "Amount"
        Case "description", "memo", "details", "narration"
            CanonicalHeader = "Description"
        Case "vendor", "supplier"
            CanonicalHeader = "Vendor"
        Case "invoice no", "invoice #", "invoice number"
            CanonicalHeader = "Invoice Number"
        Case "cost center", "cost centre"
            CanonicalHeader = "Cost Center"
        Case Else
            CanonicalHeader = WorksheetFunction.Proper(normalized)
    End Select
End Function

Private Function PrepareMasterSheet(ByVal wb As Workbook, ByVal sheetName As String) As Worksheet
    Dim ws As Worksheet

    On Error Resume Next
    Set ws = wb.Worksheets(sheetName)
    On Error GoTo 0

    If ws Is Nothing Then
        Set ws = wb.Worksheets.Add(Before:=wb.Worksheets(1))
        ws.Name = sheetName
    Else
        ws.Cells.Clear
    End If

    Set PrepareMasterSheet = ws
End Function

Private Sub FormatMasterSheet(ByVal masterSheet As Worksheet, ByVal lastRow As Long)
    Dim lastCol As Long

    lastCol = LastUsedColumn(masterSheet)

    With masterSheet.Range(masterSheet.Cells(1, 1), masterSheet.Cells(1, lastCol))
        .Font.Bold = True
        .Interior.Color = RGB(45, 90, 61)
        .Font.Color = RGB(255, 255, 255)
    End With

    If lastRow >= 1 Then
        masterSheet.Range(masterSheet.Cells(1, 1), masterSheet.Cells(lastRow, lastCol)).AutoFilter
    End If

    masterSheet.Columns.AutoFit
End Sub

Private Function ShouldImportSheet(ByVal sourceSheet As Worksheet) As Boolean
    If sourceSheet.Name = MASTER_SHEET_NAME Then Exit Function
    If sourceSheet.Visible <> xlSheetVisible Then Exit Function
    If WorksheetFunction.CountA(sourceSheet.Cells) = 0 Then Exit Function
    ShouldImportSheet = True
End Function

Private Function RowHasData(ByVal sourceSheet As Worksheet, ByVal rowIndex As Long, ByVal lastCol As Long) As Boolean
    RowHasData = (WorksheetFunction.CountA(sourceSheet.Range(sourceSheet.Cells(rowIndex, 1), sourceSheet.Cells(rowIndex, lastCol))) > 0)
End Function

Private Function DetectHeaderRow(ByVal ws As Worksheet, ByVal searchRows As Long) As Long
    Dim rowIndex As Long
    Dim populatedCells As Long
    Dim bestCount As Long
    Dim bestRow As Long

    For rowIndex = 1 To WorksheetFunction.Min(searchRows, ws.Rows.Count)
        populatedCells = WorksheetFunction.CountA(ws.Rows(rowIndex))
        If populatedCells > bestCount Then
            bestCount = populatedCells
            bestRow = rowIndex
        End If
    Next rowIndex

    DetectHeaderRow = bestRow
End Function

Private Function LastUsedRow(ByVal ws As Worksheet) As Long
    Dim lastCell As Range

    On Error Resume Next
    Set lastCell = ws.Cells.Find(What:="*", After:=ws.Range("A1"), LookIn:=xlFormulas, _
                                 SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    On Error GoTo 0

    If lastCell Is Nothing Then
        LastUsedRow = 0
    Else
        LastUsedRow = lastCell.Row
    End If
End Function

Private Function LastUsedColumn(ByVal ws As Worksheet) As Long
    Dim lastCell As Range

    On Error Resume Next
    Set lastCell = ws.Cells.Find(What:="*", After:=ws.Range("A1"), LookIn:=xlFormulas, _
                                 SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
    On Error GoTo 0

    If lastCell Is Nothing Then
        LastUsedColumn = 0
    Else
        LastUsedColumn = lastCell.Column
    End If
End Function