Budget & Expense Tracker with Variance

' Budget & Expense Tracker with Variance Analysis
' Sheet structure: Category (A), Budget (B), Actual (C), Variance (D), % Variance (E), Status (F)

Sub CalculateVariances()
    ' Calculate variances between budget and actual expenses
    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

    ' Validate headers
    If ws.Cells(1, 1).Value <> "Category" Then
        MsgBox "Please ensure headers are in row 1: Category, Budget, Actual, Variance, % Variance, Status", vbExclamation
        Exit Sub
    End If

    Dim i As Long
    For i = 2 To lastRow
        Dim budget As Double
        Dim actual As Double
        Dim variance As Double
        Dim percentVariance As Double

        ' Get budget and actual values
        budget = Val(ws.Cells(i, 2).Value)
        actual = Val(ws.Cells(i, 3).Value)

        ' Calculate variance (positive = under budget, negative = over budget)
        variance = budget - actual
        ws.Cells(i, 4).Value = variance

        ' Calculate percentage variance
        If budget > 0 Then
            percentVariance = (variance / budget) * 100
            ws.Cells(i, 5).Value = percentVariance
            ws.Cells(i, 5).NumberFormat = "0.00%"
        Else
            ws.Cells(i, 5).Value = "N/A"
        End If

        ' Determine status
        Dim status As String
        If actual = 0 Then
            status = "No Data"
        ElseIf variance > 0 Then
            status = "Under Budget"
        ElseIf variance < 0 Then
            status = "Over Budget"
        Else
            status = "On Budget"
        End If

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

        ' Apply conditional formatting
        Select Case status
            Case "Under Budget"
                ws.Cells(i, 6).Interior.Color = RGB(144, 238, 144) ' Light green
            Case "Over Budget"
                ws.Cells(i, 6).Interior.Color = RGB(255, 160, 122) ' Light red
            Case "On Budget"
                ws.Cells(i, 6).Interior.Color = RGB(173, 216, 230) ' Light blue
            Case Else
                ws.Cells(i, 6).Interior.ColorIndex = xlNone
        End Select
    Next i

    ' Format currency columns
    ws.Range("B2:D" & lastRow).NumberFormat = "£#,##0.00"

    Application.ScreenUpdating = True

    MsgBox "Variance analysis complete!", vbInformation

    Exit Sub

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

Sub GenerateVarianceReport()
    ' Create summary report of variances
    On Error GoTo ErrorHandler

    Dim sourceWS As Worksheet
    Set sourceWS = ActiveSheet

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

    ' Create or clear report sheet
    Dim reportWS As Worksheet
    On Error Resume Next
    Set reportWS = ThisWorkbook.Sheets("Variance Report")
    On Error GoTo ErrorHandler

    If reportWS Is Nothing Then
        Set reportWS = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        reportWS.Name = "Variance Report"
    Else
        reportWS.Cells.Clear
    End If

    ' Create report headers
    reportWS.Cells(1, 1).Value = "Budget Variance Report"
    reportWS.Cells(1, 1).Font.Size = 16
    reportWS.Cells(1, 1).Font.Bold = True

    reportWS.Cells(2, 1).Value = "Generated: " & Format(Now, "dd/mm/yyyy hh:mm")

    reportWS.Cells(4, 1).Value = "Summary Statistics"
    reportWS.Cells(4, 1).Font.Bold = True

    ' Calculate totals
    Dim totalBudget As Double
    Dim totalActual As Double
    Dim totalVariance As Double

    Dim i As Long
    For i = 2 To lastRow
        totalBudget = totalBudget + Val(sourceWS.Cells(i, 2).Value)
        totalActual = totalActual + Val(sourceWS.Cells(i, 3).Value)
    Next i

    totalVariance = totalBudget - totalActual

    ' Write summary
    reportWS.Cells(5, 1).Value = "Total Budget:"
    reportWS.Cells(5, 2).Value = totalBudget
    reportWS.Cells(5, 2).NumberFormat = "£#,##0.00"

    reportWS.Cells(6, 1).Value = "Total Actual:"
    reportWS.Cells(6, 2).Value = totalActual
    reportWS.Cells(6, 2).NumberFormat = "£#,##0.00"

    reportWS.Cells(7, 1).Value = "Total Variance:"
    reportWS.Cells(7, 2).Value = totalVariance
    reportWS.Cells(7, 2).NumberFormat = "£#,##0.00"

    If totalVariance >= 0 Then
        reportWS.Cells(7, 2).Interior.Color = RGB(144, 238, 144)
    Else
        reportWS.Cells(7, 2).Interior.Color = RGB(255, 160, 122)
    End If

    ' Categories over budget
    reportWS.Cells(9, 1).Value = "Categories Over Budget"
    reportWS.Cells(9, 1).Font.Bold = True

    Dim overBudgetRow As Long
    overBudgetRow = 10

    For i = 2 To lastRow
        If sourceWS.Cells(i, 6).Value = "Over Budget" Then
            reportWS.Cells(overBudgetRow, 1).Value = sourceWS.Cells(i, 1).Value
            reportWS.Cells(overBudgetRow, 2).Value = sourceWS.Cells(i, 4).Value
            reportWS.Cells(overBudgetRow, 2).NumberFormat = "£#,##0.00"
            overBudgetRow = overBudgetRow + 1
        End If
    Next i

    If overBudgetRow = 10 Then
        reportWS.Cells(10, 1).Value = "None"
    End If

    ' Auto-fit columns
    reportWS.Columns("A:B").AutoFit

    MsgBox "Variance report generated in 'Variance Report' sheet!", vbInformation

    Exit Sub

ErrorHandler:
    MsgBox "Error generating report: " & Err.Description, vbCritical
End Sub

Sub AlertOverspending()
    ' Display alert for categories significantly over budget
    On Error GoTo ErrorHandler

    Dim ws As Worksheet
    Set ws = ActiveSheet

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

    Dim alertMessage As String
    alertMessage = "Budget Alerts:" & vbCrLf & vbCrLf

    Dim alertCount As Integer
    alertCount = 0

    Dim i As Long
    For i = 2 To lastRow
        Dim percentVariance As Double
        percentVariance = Val(ws.Cells(i, 5).Value)

        ' Alert if over budget by more than 10%
        If percentVariance < -10 Then
            alertMessage = alertMessage & ws.Cells(i, 1).Value & ": " & _
                          Format(Abs(percentVariance), "0.00") & "% over budget" & vbCrLf
            alertCount = alertCount + 1
        End If
    Next i

    If alertCount = 0 Then
        MsgBox "No budget alerts. All categories within acceptable limits.", vbInformation
    Else
        MsgBox alertMessage, vbExclamation, "Budget Alert - " & alertCount & " Category(ies)"
    End If

    Exit Sub

ErrorHandler:
    MsgBox "Error checking alerts: " & Err.Description, vbCritical
End Sub