Attribute VB_Name = "AutoFormatBankStatement"
Option Explicit

' MacroWise Starter Kit
' Macro 1: Auto-format bank statement imports
' Compatible with Excel 2016+

Public Sub AutoFormatActiveBankStatement()
    Dim ws As Worksheet
    Dim headerRow As Long
    Dim lastRow As Long
    Dim lastCol As Long
    Dim dataRange As Range
    Dim amountColumns As Collection
    Dim dateColumns As Collection
    Dim currentColumn As Variant

    On Error GoTo CleanFail

    Set ws = ActiveSheet
    If ws Is Nothing Then
        MsgBox "Open the worksheet you want to format and run the macro again.", vbExclamation, "MacroWise"
        Exit Sub
    End If

    headerRow = DetectHeaderRow(ws, 10)
    lastRow = LastUsedRow(ws)
    lastCol = LastUsedColumn(ws)

    If headerRow = 0 Or lastRow <= headerRow Or lastCol = 0 Then
        MsgBox "The active sheet does not contain a usable bank statement table.", vbExclamation, "MacroWise"
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    NormalizeHeaders ws, headerRow, lastCol
    Set dataRange = ws.Range(ws.Cells(headerRow, 1), ws.Cells(lastRow, lastCol))

    If ws.AutoFilterMode Then
        ws.AutoFilterMode = False
    End If

    dataRange.AutoFilter
    FormatHeaderRow ws, headerRow, lastCol

    Set amountColumns = FindMatchingColumns(ws, headerRow, lastCol, Array("amount", "debit", "credit", "balance", "withdrawal", "deposit"))
    Set dateColumns = FindMatchingColumns(ws, headerRow, lastCol, Array("date", "posted", "posting", "value date", "transaction date"))

    For Each currentColumn In amountColumns
        FormatAmountColumn ws, CLng(currentColumn), headerRow + 1, lastRow
    Next currentColumn

    For Each currentColumn In dateColumns
        FormatDateColumn ws, CLng(currentColumn), headerRow + 1, lastRow
    Next currentColumn

    ws.Columns.AutoFit
    ws.Rows(headerRow).WrapText = False
    dataRange.Borders(xlEdgeBottom).LineStyle = xlContinuous
    dataRange.Borders(xlEdgeBottom).Color = RGB(199, 151, 59)

    Application.Goto ws.Cells(headerRow, 1), True

    MsgBox "Bank statement formatting complete." & vbCrLf & vbCrLf & _
           "Headers normalized, filters added, dates and amounts cleaned, and column widths adjusted.", _
           vbInformation, "MacroWise"

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

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

Private Sub NormalizeHeaders(ByVal ws As Worksheet, ByVal headerRow As Long, ByVal lastCol As Long)
    Dim columnIndex As Long
    Dim rawHeader As String
    Dim normalizedHeader As String

    For columnIndex = 1 To lastCol
        rawHeader = Trim$(CStr(ws.Cells(headerRow, columnIndex).Value))

        If Len(rawHeader) = 0 Then
            normalizedHeader = "Column " & columnIndex
        Else
            normalizedHeader = rawHeader
            normalizedHeader = Replace(normalizedHeader, "_", " ")
            normalizedHeader = Replace(normalizedHeader, "-", " ")
            normalizedHeader = WorksheetFunction.Trim(normalizedHeader)
            normalizedHeader = WorksheetFunction.Proper(LCase$(normalizedHeader))
        End If

        ws.Cells(headerRow, columnIndex).Value = normalizedHeader
    Next columnIndex
End Sub

Private Sub FormatHeaderRow(ByVal ws As Worksheet, ByVal headerRow As Long, ByVal lastCol As Long)
    With ws.Range(ws.Cells(headerRow, 1), ws.Cells(headerRow, lastCol))
        .Font.Bold = True
        .Interior.Color = RGB(45, 90, 61)
        .Font.Color = RGB(255, 255, 255)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .RowHeight = 22
    End With
End Sub

Private Sub FormatAmountColumn(ByVal ws As Worksheet, ByVal columnIndex As Long, ByVal firstDataRow As Long, ByVal lastRow As Long)
    Dim rowIndex As Long
    Dim cleanedValue As Variant

    For rowIndex = firstDataRow To lastRow
        cleanedValue = CleanAmountValue(ws.Cells(rowIndex, columnIndex).Value)
        If Not IsEmpty(cleanedValue) Then
            ws.Cells(rowIndex, columnIndex).Value = cleanedValue
        End If
    Next rowIndex

    ws.Range(ws.Cells(firstDataRow, columnIndex), ws.Cells(lastRow, columnIndex)).NumberFormat = "#,##0.00_);(#,##0.00)"
    ws.Columns(columnIndex).HorizontalAlignment = xlRight
End Sub

Private Sub FormatDateColumn(ByVal ws As Worksheet, ByVal columnIndex As Long, ByVal firstDataRow As Long, ByVal lastRow As Long)
    Dim rowIndex As Long
    Dim cellValue As Variant

    For rowIndex = firstDataRow To lastRow
        cellValue = ws.Cells(rowIndex, columnIndex).Value
        If IsDate(cellValue) Then
            ws.Cells(rowIndex, columnIndex).Value = CDate(cellValue)
        End If
    Next rowIndex

    ws.Range(ws.Cells(firstDataRow, columnIndex), ws.Cells(lastRow, columnIndex)).NumberFormat = "dd-mmm-yyyy"
End Sub

Private Function FindMatchingColumns(ByVal ws As Worksheet, ByVal headerRow As Long, ByVal lastCol As Long, ByVal patterns As Variant) As Collection
    Dim results As New Collection
    Dim columnIndex As Long
    Dim headerText As String
    Dim pattern As Variant

    For columnIndex = 1 To lastCol
        headerText = LCase$(Trim$(CStr(ws.Cells(headerRow, columnIndex).Value)))

        For Each pattern In patterns
            If InStr(1, headerText, CStr(pattern), vbTextCompare) > 0 Then
                results.Add columnIndex
                Exit For
            End If
        Next pattern
    Next columnIndex

    Set FindMatchingColumns = results
End Function

Private Function CleanAmountValue(ByVal rawValue As Variant) As Variant
    Dim workingValue As String
    Dim isNegative As Boolean

    If IsEmpty(rawValue) Or Len(Trim$(CStr(rawValue))) = 0 Then
        CleanAmountValue = Empty
        Exit Function
    End If

    If IsNumeric(rawValue) Then
        CleanAmountValue = CDbl(rawValue)
        Exit Function
    End If

    workingValue = Trim$(CStr(rawValue))
    isNegative = (InStr(workingValue, "(") > 0 And InStr(workingValue, ")") > 0)

    workingValue = Replace(workingValue, "$", "")
    workingValue = Replace(workingValue, ",", "")
    workingValue = Replace(workingValue, " ", "")
    workingValue = Replace(workingValue, "(", "")
    workingValue = Replace(workingValue, ")", "")

    If Len(workingValue) = 0 Or Not IsNumeric(workingValue) Then
        CleanAmountValue = Empty
        Exit Function
    End If

    CleanAmountValue = CDbl(workingValue)
    If isNegative Then
        CleanAmountValue = CleanAmountValue * -1
    End If
End Function

Private Function DetectHeaderRow(ByVal ws As Worksheet, ByVal searchRows As Long) As Long
    Dim rowIndex As Long
    Dim populatedCells As Long
    Dim bestRow As Long
    Dim bestCount 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