Expense Report Automator

' Expense Report Automator
' Sheet structure: Date (A), Category (B), Description (C), Amount (D),
'   Currency (E), GBP Amount (F), Receipt (G), Status (H)
' Categories: Travel, Meals, Accommodation, Transport, Office Supplies,
'   Client Entertainment, Mileage, Other

Sub ProcessExpenseReport()
    ' Validate and process expense entries
    On Error GoTo ErrorHandler

    Application.ScreenUpdating = False

    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    If lastRow < 2 Then
        MsgBox "No expense data found.", vbExclamation
        Exit Sub
    End If

    ' Ensure headers
    If ws.Cells(1, 1).Value = "" Then
        ws.Cells(1, 1).Value = "Date"
        ws.Cells(1, 2).Value = "Category"
        ws.Cells(1, 3).Value = "Description"
        ws.Cells(1, 4).Value = "Amount"
        ws.Cells(1, 5).Value = "Currency"
        ws.Cells(1, 6).Value = "GBP Amount"
        ws.Cells(1, 7).Value = "Receipt"
        ws.Cells(1, 8).Value = "Status"

        With ws.Range("A1:H1")
            .Font.Bold = True
            .Interior.Color = RGB(0, 102, 204)
            .Font.Color = RGB(255, 255, 255)
        End With
    End If

    ' Policy limits by category
    Dim policyLimits As Object
    Set policyLimits = CreateObject("Scripting.Dictionary")
    policyLimits.Add "Meals", 50
    policyLimits.Add "Client Entertainment", 150
    policyLimits.Add "Accommodation", 200
    policyLimits.Add "Transport", 100
    policyLimits.Add "Office Supplies", 75

    Dim totalAmount As Double
    Dim flaggedCount As Long
    Dim validCount As Long

    Dim i As Long
    For i = 2 To lastRow
        Dim expDate As String
        Dim category As String
        Dim amount As Double
        Dim currency As String
        Dim gbpAmount As Double

        expDate = ws.Cells(i, 1).Value
        category = ws.Cells(i, 2).Value
        amount = Val(ws.Cells(i, 4).Value)
        currency = UCase(Trim(ws.Cells(i, 5).Value))
        If currency = "" Then currency = "GBP"

        ' Convert to GBP (simplified rates)
        Select Case currency
            Case "GBP"
                gbpAmount = amount
            Case "EUR"
                gbpAmount = amount * 0.86
            Case "USD"
                gbpAmount = amount * 0.79
            Case Else
                gbpAmount = amount
        End Select

        ws.Cells(i, 6).Value = Round(gbpAmount, 2)
        ws.Cells(i, 6).NumberFormat = "#,##0.00"

        ' Validate against policy
        Dim status As String
        Dim hasReceipt As Boolean
        hasReceipt = (UCase(ws.Cells(i, 7).Value) = "YES" Or UCase(ws.Cells(i, 7).Value) = "Y")

        ' Check policy limit
        If policyLimits.Exists(category) Then
            If gbpAmount > policyLimits(category) Then
                status = "Over Limit"
                flaggedCount = flaggedCount + 1
            ElseIf Not hasReceipt And gbpAmount > 25 Then
                status = "Receipt Required"
                flaggedCount = flaggedCount + 1
            Else
                status = "Valid"
                validCount = validCount + 1
            End If
        Else
            If Not hasReceipt And gbpAmount > 25 Then
                status = "Receipt Required"
                flaggedCount = flaggedCount + 1
            Else
                status = "Valid"
                validCount = validCount + 1
            End If
        End If

        ws.Cells(i, 8).Value = status

        ' Colour code
        Select Case status
            Case "Valid"
                ws.Cells(i, 8).Interior.Color = RGB(200, 240, 200)
            Case "Over Limit"
                ws.Cells(i, 8).Interior.Color = RGB(255, 150, 150)
            Case "Receipt Required"
                ws.Cells(i, 8).Interior.Color = RGB(255, 230, 150)
        End Select

        totalAmount = totalAmount + gbpAmount
    Next i

    ' Add total row
    ws.Cells(lastRow + 2, 5).Value = "Total (GBP):"
    ws.Cells(lastRow + 2, 5).Font.Bold = True
    ws.Cells(lastRow + 2, 6).Value = Round(totalAmount, 2)
    ws.Cells(lastRow + 2, 6).NumberFormat = "#,##0.00"
    ws.Cells(lastRow + 2, 6).Font.Bold = True
    ws.Cells(lastRow + 2, 6).Font.Size = 12

    ws.Columns("A:H").AutoFit

    Application.ScreenUpdating = True

    MsgBox "Expense report processed:" & vbCrLf & _
           "Valid entries: " & validCount & vbCrLf & _
           "Flagged entries: " & flaggedCount & vbCrLf & _
           "Total (GBP): " & Format(totalAmount, "#,##0.00"), vbInformation

    Exit Sub

ErrorHandler:
    Application.ScreenUpdating = True
    MsgBox "Error processing expenses: " & Err.Description, vbCritical
End Sub

Sub GenerateMonthlySummary()
    ' Create monthly expense summary by category
    On Error GoTo ErrorHandler

    Application.ScreenUpdating = False

    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' Collect by category
    Dim catTotals As Object
    Set catTotals = CreateObject("Scripting.Dictionary")

    Dim i As Long
    For i = 2 To lastRow
        If ws.Cells(i, 2).Value <> "" Then
            Dim cat As String
            cat = ws.Cells(i, 2).Value

            If catTotals.Exists(cat) Then
                catTotals(cat) = catTotals(cat) + Val(ws.Cells(i, 6).Value)
            Else
                catTotals.Add cat, Val(ws.Cells(i, 6).Value)
            End If
        End If
    Next i

    ' Create summary sheet
    Dim wsSummary As Worksheet
    On Error Resume Next
    Set wsSummary = ThisWorkbook.Sheets("Expense Summary")
    On Error GoTo ErrorHandler

    If wsSummary Is Nothing Then
        Set wsSummary = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsSummary.Name = "Expense Summary"
    Else
        wsSummary.Cells.Clear
    End If

    wsSummary.Cells(1, 1).Value = "Monthly Expense Summary"
    wsSummary.Cells(1, 1).Font.Size = 16
    wsSummary.Cells(1, 1).Font.Bold = True
    wsSummary.Cells(2, 1).Value = "Generated: " & Format(Now, "dd/mm/yyyy")

    wsSummary.Cells(4, 1).Value = "Category"
    wsSummary.Cells(4, 2).Value = "Total (GBP)"
    wsSummary.Cells(4, 3).Value = "% of Total"

    With wsSummary.Range("A4:C4")
        .Font.Bold = True
        .Interior.Color = RGB(0, 102, 204)
        .Font.Color = RGB(255, 255, 255)
    End With

    Dim grandTotal As Double
    Dim key As Variant
    For Each key In catTotals.Keys
        grandTotal = grandTotal + catTotals(key)
    Next key

    Dim row As Long
    row = 5
    For Each key In catTotals.Keys
        wsSummary.Cells(row, 1).Value = key
        wsSummary.Cells(row, 2).Value = Round(catTotals(key), 2)
        wsSummary.Cells(row, 2).NumberFormat = "#,##0.00"
        If grandTotal > 0 Then
            wsSummary.Cells(row, 3).Value = catTotals(key) / grandTotal
            wsSummary.Cells(row, 3).NumberFormat = "0.0%"
        End If
        row = row + 1
    Next key

    ' Grand total
    wsSummary.Cells(row + 1, 1).Value = "Grand Total"
    wsSummary.Cells(row + 1, 1).Font.Bold = True
    wsSummary.Cells(row + 1, 2).Value = Round(grandTotal, 2)
    wsSummary.Cells(row + 1, 2).NumberFormat = "#,##0.00"
    wsSummary.Cells(row + 1, 2).Font.Bold = True

    wsSummary.Columns("A:C").AutoFit

    Application.ScreenUpdating = True

    MsgBox "Monthly expense summary generated!", vbInformation

    Exit Sub

ErrorHandler:
    Application.ScreenUpdating = True
    MsgBox "Error generating summary: " & Err.Description, vbCritical
End Sub