Building an Automated Reporting System with VBA

Picture this: It's Monday morning, and your manager needs the weekly sales performance report by 10 AM. You know the drill—pull data from three different worksheets, calculate regional performance metrics, format everything just right, and email it to stakeholders. By the time you're done, it's 11:30 AM and you've barely touched your actual analytical work.

This scenario plays out in offices everywhere, consuming hours of valuable time that could be spent on strategic analysis instead of manual report generation. The solution? An automated reporting system built with VBA that can transform raw data into polished reports at the click of a button.

By the end of this lesson, you'll have built a complete automated reporting system that can handle data processing, calculations, formatting, and distribution—all without manual intervention. More importantly, you'll understand the architectural principles that make such systems maintainable and scalable.

What you'll learn:

• Design a modular VBA architecture for automated reporting
• Build dynamic data processing routines that adapt to changing data sizes
• Implement error handling and logging for production-ready automation
• Create user-friendly interfaces for non-technical stakeholders
• Automate report formatting and distribution via email
• Structure your code for long-term maintenance and updates

Prerequisites

You should be comfortable with VBA fundamentals including variables, loops, and basic object manipulation. Experience with Excel formulas and pivot tables will help, though we'll review key concepts as needed. Most importantly, you should understand basic database concepts like joins and aggregations since we'll be processing relational data.

System Architecture and Design Principles

Before writing any code, let's establish the architecture that will make our reporting system robust and maintainable. A well-designed automated reporting system follows the separation of concerns principle—each module handles one specific responsibility.

Our system will consist of four main components:

Data Layer: Handles all data import, cleaning, and validation. This module connects to source data and ensures it meets quality standards before processing.

Processing Layer: Performs calculations, aggregations, and transformations. This is where business logic lives—the rules that define how raw data becomes meaningful insights.

Presentation Layer: Handles formatting, chart creation, and report layout. This module makes data visually compelling and professional.

Distribution Layer: Manages report output, including saving files and sending emails. This ensures reports reach the right people in the right format.

This separation means you can modify formatting without touching calculation logic, or change data sources without rewriting the entire system. Let's see this in action.

Setting Up the Foundation

We'll start by creating a module structure that supports our architecture. Create a new workbook and add four new modules through the VBA editor: DataProcessor, BusinessLogic, ReportFormatter, and ReportDistributor.

First, let's establish our main controller module that orchestrates the entire process:

' Module: MainController
Option Explicit

Public Sub GenerateWeeklySalesReport()
    Dim startTime As Double
    startTime = Timer
    
    ' Initialize logging
    Call LogMessage("Starting weekly sales report generation", "INFO")
    
    On Error GoTo ErrorHandler
    
    ' Step 1: Process data
    Call DataProcessor.ImportAndCleanData
    
    ' Step 2: Perform calculations
    Call BusinessLogic.CalculateMetrics
    
    ' Step 3: Format report
    Call ReportFormatter.CreateFormattedReport
    
    ' Step 4: Distribute report
    Call ReportDistributor.SendReportEmail
    
    Call LogMessage("Report completed in " & Round(Timer - startTime, 2) & " seconds", "SUCCESS")
    
    MsgBox "Weekly sales report generated and distributed successfully!", vbInformation
    Exit Sub
    
ErrorHandler:
    Call LogMessage("Error in main process: " & Err.Description, "ERROR")
    MsgBox "Error generating report: " & Err.Description, vbCritical
End Sub

Private Sub LogMessage(message As String, logType As String)
    ' Simple logging to immediate window - enhance for production
    Debug.Print Format(Now, "yyyy-mm-dd hh:mm:ss") & " [" & logType & "] " & message
End Sub

This controller provides a clean interface for report generation while handling errors gracefully. The logging function will help you troubleshoot issues when things go wrong—and they will go wrong.

Building the Data Processing Layer

The data processing layer is where reliability matters most. Bad data in means bad reports out, so we'll implement robust validation and cleaning routines.

' Module: DataProcessor
Option Explicit

Public Sub ImportAndCleanData()
    Dim wsRawData As Worksheet, wsCleanData As Worksheet
    Dim lastRow As Long, i As Long
    Dim dataRange As Range
    
    ' Reference worksheets
    Set wsRawData = ThisWorkbook.Worksheets("RawSalesData")
    Set wsCleanData = GetOrCreateWorksheet("ProcessedData")
    
    ' Clear previous processed data
    wsCleanData.Cells.Clear
    
    ' Get data boundaries dynamically
    lastRow = wsRawData.Cells(wsRawData.Rows.Count, 1).End(xlUp).Row
    
    If lastRow < 2 Then
        Err.Raise 1001, "DataProcessor", "No data found in RawSalesData worksheet"
    End If
    
    ' Copy headers
    wsRawData.Range("A1:F1").Copy wsCleanData.Range("A1")
    
    ' Process data row by row with validation
    Dim outputRow As Long
    outputRow = 2
    
    For i = 2 To lastRow
        If ValidateDataRow(wsRawData, i) Then
            Call CopyAndCleanRow(wsRawData, wsCleanData, i, outputRow)
            outputRow = outputRow + 1
        End If
    Next i
    
    ' Add calculated columns
    Call AddCalculatedColumns(wsCleanData, outputRow - 1)
    
    Debug.Print "Processed " & (outputRow - 2) & " valid records from " & (lastRow - 1) & " total records"
End Sub

Private Function ValidateDataRow(ws As Worksheet, rowNum As Long) As Boolean
    ValidateDataRow = True
    
    ' Check for required fields
    If IsEmpty(ws.Cells(rowNum, 1)) Or IsEmpty(ws.Cells(rowNum, 2)) Then
        ValidateDataRow = False
        Debug.Print "Row " & rowNum & ": Missing required data"
        Exit Function
    End If
    
    ' Validate date format
    If Not IsDate(ws.Cells(rowNum, 1)) Then
        ValidateDataRow = False
        Debug.Print "Row " & rowNum & ": Invalid date format"
        Exit Function
    End If
    
    ' Validate numeric fields
    If Not IsNumeric(ws.Cells(rowNum, 5)) Or ws.Cells(rowNum, 5) < 0 Then
        ValidateDataRow = False
        Debug.Print "Row " & rowNum & ": Invalid sales amount"
        Exit Function
    End If
End Function

Private Sub CopyAndCleanRow(wsSource As Worksheet, wsDest As Worksheet, sourceRow As Long, destRow As Long)
    ' Copy and clean data with proper formatting
    wsDest.Cells(destRow, 1) = CDate(wsSource.Cells(sourceRow, 1)) ' Date
    wsDest.Cells(destRow, 2) = Trim(wsSource.Cells(sourceRow, 2))  ' Region
    wsDest.Cells(destRow, 3) = Trim(wsSource.Cells(sourceRow, 3))  ' Salesperson
    wsDest.Cells(destRow, 4) = Trim(wsSource.Cells(sourceRow, 4))  ' Product
    wsDest.Cells(destRow, 5) = CDbl(wsSource.Cells(sourceRow, 5))  ' Amount
    wsDest.Cells(destRow, 6) = CInt(wsSource.Cells(sourceRow, 6))  ' Quantity
End Sub

Private Function GetOrCreateWorksheet(wsName As String) As Worksheet
    Dim ws As Worksheet
    
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets(wsName)
    On Error GoTo 0
    
    If ws Is Nothing Then
        Set ws = ThisWorkbook.Worksheets.Add
        ws.Name = wsName
    End If
    
    Set GetOrCreateWorksheet = ws
End Function

Private Sub AddCalculatedColumns(ws As Worksheet, lastRow As Long)
    ' Add headers for calculated columns
    ws.Cells(1, 7) = "Week"
    ws.Cells(1, 8) = "Month"
    ws.Cells(1, 9) = "Quarter"
    
    Dim i As Long
    For i = 2 To lastRow + 1
        ws.Cells(i, 7) = Format(ws.Cells(i, 1), "yyyy-ww")  ' Week
        ws.Cells(i, 8) = Format(ws.Cells(i, 1), "yyyy-mm")  ' Month
        ws.Cells(i, 9) = "Q" & DatePart("q", ws.Cells(i, 1)) & "-" & Year(ws.Cells(i, 1))  ' Quarter
    Next i
End Sub

This data processing module demonstrates several key principles for production automation. We validate every row of data before processing, handle missing or malformed data gracefully, and add calculated fields that our business logic will need. The GetOrCreateWorksheet function ensures our system works even if someone deletes worksheets.

Pro Tip: Always log what you're skipping and why. When your manager asks why the numbers don't match the source data, you'll have an audit trail showing exactly which records were excluded for data quality issues.

Implementing Business Logic

The business logic layer transforms clean data into meaningful metrics. This is where domain knowledge meets code—you need to understand what the business actually needs, not just what the data contains.

' Module: BusinessLogic
Option Explicit

Public Sub CalculateMetrics()
    Dim wsData As Worksheet, wsMetrics As Worksheet
    Dim lastRow As Long
    
    Set wsData = ThisWorkbook.Worksheets("ProcessedData")
    Set wsMetrics = GetOrCreateWorksheet("Metrics")
    
    ' Clear previous metrics
    wsMetrics.Cells.Clear
    
    lastRow = wsData.Cells(wsData.Rows.Count, 1).End(xlUp).Row
    
    ' Calculate regional performance
    Call CalculateRegionalMetrics(wsData, wsMetrics, lastRow)
    
    ' Calculate product performance
    Call CalculateProductMetrics(wsData, wsMetrics, lastRow)
    
    ' Calculate salesperson performance
    Call CalculateSalespersonMetrics(wsData, wsMetrics, lastRow)
    
    ' Calculate time-based trends
    Call CalculateTimeTrends(wsData, wsMetrics, lastRow)
End Sub

Private Sub CalculateRegionalMetrics(wsData As Worksheet, wsMetrics As Worksheet, lastRow As Long)
    ' Create regional summary starting at row 1
    wsMetrics.Cells(1, 1) = "REGIONAL PERFORMANCE"
    wsMetrics.Cells(2, 1) = "Region"
    wsMetrics.Cells(2, 2) = "Total Sales"
    wsMetrics.Cells(2, 3) = "Units Sold"
    wsMetrics.Cells(2, 4) = "Avg Sale Size"
    wsMetrics.Cells(2, 5) = "Growth vs Previous"
    
    ' Get unique regions using collection
    Dim regions As Collection, regionData As Collection
    Set regions = GetUniqueValues(wsData.Range("B2:B" & lastRow))
    Set regionData = New Collection
    
    Dim region As Variant, currentWeekSales As Double, previousWeekSales As Double
    Dim currentRow As Long
    currentRow = 3
    
    For Each region In regions
        ' Calculate current week metrics
        currentWeekSales = CalculateRegionSales(wsData, region, GetCurrentWeek(), lastRow)
        previousWeekSales = CalculateRegionSales(wsData, region, GetPreviousWeek(), lastRow)
        
        wsMetrics.Cells(currentRow, 1) = region
        wsMetrics.Cells(currentRow, 2) = currentWeekSales
        wsMetrics.Cells(currentRow, 3) = CalculateRegionUnits(wsData, region, GetCurrentWeek(), lastRow)
        
        If wsMetrics.Cells(currentRow, 3) > 0 Then
            wsMetrics.Cells(currentRow, 4) = currentWeekSales / wsMetrics.Cells(currentRow, 3)
        End If
        
        If previousWeekSales > 0 Then
            wsMetrics.Cells(currentRow, 5) = (currentWeekSales - previousWeekSales) / previousWeekSales
            wsMetrics.Cells(currentRow, 5).NumberFormat = "0.0%"
        End If
        
        currentRow = currentRow + 1
    Next region
End Sub

Private Function CalculateRegionSales(wsData As Worksheet, region As Variant, weekString As String, lastRow As Long) As Double
    Dim i As Long, totalSales As Double
    totalSales = 0
    
    For i = 2 To lastRow
        If wsData.Cells(i, 2) = region And wsData.Cells(i, 7) = weekString Then
            totalSales = totalSales + wsData.Cells(i, 5)
        End If
    Next i
    
    CalculateRegionSales = totalSales
End Function

Private Function CalculateRegionUnits(wsData As Worksheet, region As Variant, weekString As String, lastRow As Long) As Long
    Dim i As Long, totalUnits As Long
    totalUnits = 0
    
    For i = 2 To lastRow
        If wsData.Cells(i, 2) = region And wsData.Cells(i, 7) = weekString Then
            totalUnits = totalUnits + wsData.Cells(i, 6)
        End If
    Next i
    
    CalculateRegionUnits = totalUnits
End Function

Private Function GetCurrentWeek() As String
    GetCurrentWeek = Format(Date, "yyyy-ww")
End Function

Private Function GetPreviousWeek() As String
    GetPreviousWeek = Format(Date - 7, "yyyy-ww")
End Function

Private Function GetUniqueValues(rng As Range) As Collection
    Dim uniqueVals As Collection, cell As Range
    Set uniqueVals = New Collection
    
    On Error Resume Next
    For Each cell In rng
        If Not IsEmpty(cell.Value) Then
            uniqueVals.Add cell.Value, CStr(cell.Value)
        End If
    Next cell
    On Error GoTo 0
    
    Set GetUniqueValues = uniqueVals
End Function

Private Sub CalculateProductMetrics(wsData As Worksheet, wsMetrics As Worksheet, lastRow As Long)
    ' Add product performance starting after regional data
    Dim startRow As Long
    startRow = wsMetrics.Cells(wsMetrics.Rows.Count, 1).End(xlUp).Row + 3
    
    wsMetrics.Cells(startRow, 1) = "PRODUCT PERFORMANCE"
    wsMetrics.Cells(startRow + 1, 1) = "Product"
    wsMetrics.Cells(startRow + 1, 2) = "Revenue"
    wsMetrics.Cells(startRow + 1, 3) = "Units"
    wsMetrics.Cells(startRow + 1, 4) = "Market Share %"
    
    Dim products As Collection, totalRevenue As Double
    Set products = GetUniqueValues(wsData.Range("D2:D" & lastRow))
    
    ' Calculate total revenue for market share calculation
    totalRevenue = CalculateTotalRevenue(wsData, GetCurrentWeek(), lastRow)
    
    Dim product As Variant, productRevenue As Double
    Dim currentRow As Long
    currentRow = startRow + 2
    
    For Each product In products
        productRevenue = CalculateProductSales(wsData, product, GetCurrentWeek(), lastRow)
        
        wsMetrics.Cells(currentRow, 1) = product
        wsMetrics.Cells(currentRow, 2) = productRevenue
        wsMetrics.Cells(currentRow, 3) = CalculateProductUnits(wsData, product, GetCurrentWeek(), lastRow)
        
        If totalRevenue > 0 Then
            wsMetrics.Cells(currentRow, 4) = productRevenue / totalRevenue
            wsMetrics.Cells(currentRow, 4).NumberFormat = "0.0%"
        End If
        
        currentRow = currentRow + 1
    Next product
End Sub

Private Function CalculateTotalRevenue(wsData As Worksheet, weekString As String, lastRow As Long) As Double
    Dim i As Long, total As Double
    total = 0
    
    For i = 2 To lastRow
        If wsData.Cells(i, 7) = weekString Then
            total = total + wsData.Cells(i, 5)
        End If
    Next i
    
    CalculateTotalRevenue = total
End Function

Private Function CalculateProductSales(wsData As Worksheet, product As Variant, weekString As String, lastRow As Long) As Double
    Dim i As Long, totalSales As Double
    totalSales = 0
    
    For i = 2 To lastRow
        If wsData.Cells(i, 4) = product And wsData.Cells(i, 7) = weekString Then
            totalSales = totalSales + wsData.Cells(i, 5)
        End If
    Next i
    
    CalculateProductSales = totalSales
End Function

Private Function CalculateProductUnits(wsData As Worksheet, product As Variant, weekString As String, lastRow As Long) As Long
    Dim i As Long, totalUnits As Long
    totalUnits = 0
    
    For i = 2 To lastRow
        If wsData.Cells(i, 4) = product And wsData.Cells(i, 7) = weekString Then
            totalUnits = totalUnits + wsData.Cells(i, 6)
        End If
    Next i
    
    CalculateProductUnits = totalUnits
End Function

Private Sub CalculateSalespersonMetrics(wsData As Worksheet, wsMetrics As Worksheet, lastRow As Long)
    ' Add salesperson performance rankings
    Dim startRow As Long
    startRow = wsMetrics.Cells(wsMetrics.Rows.Count, 1).End(xlUp).Row + 3
    
    wsMetrics.Cells(startRow, 1) = "TOP PERFORMERS"
    wsMetrics.Cells(startRow + 1, 1) = "Salesperson"
    wsMetrics.Cells(startRow + 1, 2) = "Sales"
    wsMetrics.Cells(startRow + 1, 3) = "Deals Closed"
    
    ' Create array to hold performance data for sorting
    Dim salespeople As Collection
    Set salespeople = GetUniqueValues(wsData.Range("C2:C" & lastRow))
    
    ' Calculate and display top 5 performers
    Dim perfArray() As Variant
    ReDim perfArray(1 To salespeople.Count, 1 To 3)
    
    Dim i As Long, person As Variant
    i = 1
    For Each person In salespeople
        perfArray(i, 1) = person
        perfArray(i, 2) = CalculateSalespersonRevenue(wsData, person, GetCurrentWeek(), lastRow)
        perfArray(i, 3) = CountSalespersonDeals(wsData, person, GetCurrentWeek(), lastRow)
        i = i + 1
    Next person
    
    ' Simple bubble sort by sales amount (for production, use more efficient sorting)
    Call SortPerformanceArray(perfArray)
    
    ' Display top 5 performers
    For i = 1 To Application.Min(5, UBound(perfArray, 1))
        wsMetrics.Cells(startRow + 1 + i, 1) = perfArray(i, 1)
        wsMetrics.Cells(startRow + 1 + i, 2) = perfArray(i, 2)
        wsMetrics.Cells(startRow + 1 + i, 3) = perfArray(i, 3)
    Next i
End Sub

Private Sub CalculateTimeTrends(wsData As Worksheet, wsMetrics As Worksheet, lastRow As Long)
    ' Add weekly trend analysis
    Dim startRow As Long
    startRow = wsMetrics.Cells(wsMetrics.Rows.Count, 1).End(xlUp).Row + 3
    
    wsMetrics.Cells(startRow, 1) = "WEEKLY TRENDS (Last 4 Weeks)"
    wsMetrics.Cells(startRow + 1, 1) = "Week"
    wsMetrics.Cells(startRow + 1, 2) = "Revenue"
    wsMetrics.Cells(startRow + 1, 3) = "Deals"
    wsMetrics.Cells(startRow + 1, 4) = "Avg Deal Size"
    
    Dim weekOffset As Long, currentDate As Date, weekString As String
    Dim weekRevenue As Double, weekDeals As Long
    
    For weekOffset = 0 To 3
        currentDate = Date - (weekOffset * 7)
        weekString = Format(currentDate, "yyyy-ww")
        
        weekRevenue = CalculateWeekRevenue(wsData, weekString, lastRow)
        weekDeals = CountWeekDeals(wsData, weekString, lastRow)
        
        wsMetrics.Cells(startRow + 2 + weekOffset, 1) = weekString
        wsMetrics.Cells(startRow + 2 + weekOffset, 2) = weekRevenue
        wsMetrics.Cells(startRow + 2 + weekOffset, 3) = weekDeals
        
        If weekDeals > 0 Then
            wsMetrics.Cells(startRow + 2 + weekOffset, 4) = weekRevenue / weekDeals
        End If
    Next weekOffset
End Sub

This business logic module shows how to structure complex calculations in a maintainable way. Each calculation function has a single responsibility, making it easy to test and modify individual metrics without affecting others.

Warning: Avoid the temptation to put all calculations in one massive function. When business requirements change (and they will), you'll thank yourself for this modular approach.

Creating Professional Report Formatting

The formatting layer transforms raw metrics into professional, readable reports. This is where attention to detail makes the difference between a report that gets used and one that gets ignored.

' Module: ReportFormatter
Option Explicit

Public Sub CreateFormattedReport()
    Dim wsMetrics As Worksheet, wsReport As Worksheet
    Dim lastRow As Long
    
    Set wsMetrics = ThisWorkbook.Worksheets("Metrics")
    Set wsReport = GetOrCreateWorksheet("WeeklyReport")
    
    ' Clear and prepare report worksheet
    wsReport.Cells.Clear
    Call SetupReportLayout(wsReport)
    
    ' Add report header with date and title
    Call CreateReportHeader(wsReport)
    
    ' Format each section of metrics
    Call FormatRegionalSection(wsMetrics, wsReport)
    Call FormatProductSection(wsMetrics, wsReport)
    Call FormatPerformersSection(wsMetrics, wsReport)
    Call FormatTrendsSection(wsMetrics, wsReport)
    
    ' Add charts and visual elements
    Call CreatePerformanceCharts(wsReport)
    
    ' Apply final formatting and protection
    Call ApplyFinalFormatting(wsReport)
    
    Debug.Print "Report formatting completed successfully"
End Sub

Private Sub SetupReportLayout(ws As Worksheet)
    ' Set up basic worksheet properties
    With ws
        .PageSetup.Orientation = xlPortrait
        .PageSetup.PaperSize = xlPaperLetter
        .PageSetup.TopMargin = Application.InchesToPoints(0.75)
        .PageSetup.BottomMargin = Application.InchesToPoints(0.75)
        .PageSetup.LeftMargin = Application.InchesToPoints(0.7)
        .PageSetup.RightMargin = Application.InchesToPoints(0.7)
        
        ' Set column widths for optimal display
        .Columns("A").ColumnWidth = 15
        .Columns("B:E").ColumnWidth = 12
        .Columns("F:H").ColumnWidth = 10
    End With
End Sub

Private Sub CreateReportHeader(ws As Worksheet)
    ' Create professional header with company branding
    With ws.Range("A1:H3")
        .Merge
        .Value = "WEEKLY SALES PERFORMANCE REPORT" & vbNewLine & _
                "Week Ending: " & Format(Date, "mmmm dd, yyyy") & vbNewLine & _
                "Generated: " & Format(Now, "mm/dd/yyyy hh:mm AM/PM")
        .Font.Name = "Arial"
        .Font.Size = 14
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Interior.Color = RGB(79, 129, 189)
        .Font.Color = RGB(255, 255, 255)
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThick
    End With
    
    ' Add separator line
    With ws.Range("A4:H4")
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlEdgeBottom).Color = RGB(79, 129, 189)
    End With
End Sub

Private Sub FormatRegionalSection(wsMetrics As Worksheet, wsReport As Worksheet)
    Dim sourceStart As Long, reportStart As Long
    Dim sourceEnd As Long, i As Long
    
    ' Find the regional data in metrics worksheet
    sourceStart = FindSectionStart(wsMetrics, "REGIONAL PERFORMANCE")
    If sourceStart = 0 Then Exit Sub
    
    sourceEnd = FindSectionEnd(wsMetrics, sourceStart)
    reportStart = 6 ' Start after header
    
    ' Copy and format section header
    With wsReport.Range("A" & reportStart & ":E" & reportStart)
        .Value = Array("REGIONAL PERFORMANCE", "", "", "", "")
        .Font.Size = 12
        .Font.Bold = True
        .Font.Color = RGB(79, 129, 189)
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Weight = xlMedium
    End With
    
    ' Copy headers and data
    For i = sourceStart + 1 To sourceEnd
        wsReport.Range("A" & (reportStart + i - sourceStart)).Resize(1, 5).Value = _
            wsMetrics.Range("A" & i & ":E" & i).Value
    Next i
    
    ' Apply formatting to data rows
    With wsReport.Range("A" & (reportStart + 1) & ":E" & (reportStart + sourceEnd - sourceStart))
        .Font.Name = "Arial"
        .Font.Size = 10
        .Borders.LineStyle = xlThin
        .Borders.Color = RGB(200, 200, 200)
        
        ' Format headers
        .Rows(1).Font.Bold = True
        .Rows(1).Interior.Color = RGB(242, 242, 242)
        
        ' Format currency columns
        .Columns("B:D").NumberFormat = "$#,##0"
        
        ' Conditional formatting for growth column
        Call ApplyConditionalFormatting(wsReport.Range("E" & (reportStart + 2) & ":E" & (reportStart + sourceEnd - sourceStart)))
    End With
End Sub

Private Sub ApplyConditionalFormatting(rng As Range)
    ' Add conditional formatting for positive/negative growth
    Dim cell As Range
    For Each cell In rng
        If IsNumeric(cell.Value) And cell.Value <> 0 Then
            If cell.Value > 0 Then
                cell.Interior.Color = RGB(198, 239, 206) ' Light green
                cell.Font.Color = RGB(0, 97, 0)          ' Dark green
            Else
                cell.Interior.Color = RGB(255, 199, 206) ' Light red
                cell.Font.Color = RGB(156, 0, 6)         ' Dark red
            End If
        End If
    Next cell
End Sub

Private Function FindSectionStart(ws As Worksheet, sectionName As String) As Long
    Dim i As Long
    For i = 1 To ws.UsedRange.Rows.Count
        If InStr(1, ws.Cells(i, 1).Value, sectionName, vbTextCompare) > 0 Then
            FindSectionStart = i
            Exit Function
        End If
    Next i
    FindSectionStart = 0
End Function

Private Function FindSectionEnd(ws As Worksheet, startRow As Long) As Long
    Dim i As Long
    For i = startRow + 1 To ws.UsedRange.Rows.Count
        If ws.Cells(i, 1).Value = "" And ws.Cells(i + 1, 1).Value = "" Then
            FindSectionEnd = i - 1
            Exit Function
        End If
        ' Check if we hit another section header
        If Len(ws.Cells(i, 1).Value) > 0 And InStr(1, ws.Cells(i, 1).Value, "PERFORMANCE", vbTextCompare) > 0 Then
            FindSectionEnd = i - 2
            Exit Function
        End If
    Next i
    FindSectionEnd = ws.UsedRange.Rows.Count
End Function

Private Sub FormatProductSection(wsMetrics As Worksheet, wsReport As Worksheet)
    Dim sourceStart As Long, reportStart As Long
    Dim sourceEnd As Long, i As Long
    
    sourceStart = FindSectionStart(wsMetrics, "PRODUCT PERFORMANCE")
    If sourceStart = 0 Then Exit Sub
    
    sourceEnd = FindSectionEnd(wsMetrics, sourceStart)
    reportStart = wsReport.Cells(wsReport.Rows.Count, 1).End(xlUp).Row + 3
    
    ' Similar formatting logic as regional section
    With wsReport.Range("A" & reportStart & ":D" & reportStart)
        .Value = Array("PRODUCT PERFORMANCE", "", "", "")
        .Font.Size = 12
        .Font.Bold = True
        .Font.Color = RGB(79, 129, 189)
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Weight = xlMedium
    End With
    
    For i = sourceStart + 1 To sourceEnd
        wsReport.Range("A" & (reportStart + i - sourceStart)).Resize(1, 4).Value = _
            wsMetrics.Range("A" & i & ":D" & i).Value
    Next i
    
    With wsReport.Range("A" & (reportStart + 1) & ":D" & (reportStart + sourceEnd - sourceStart))
        .Font.Name = "Arial"
        .Font.Size = 10
        .Borders.LineStyle = xlThin
        .Borders.Color = RGB(200, 200, 200)
        .Rows(1).Font.Bold = True
        .Rows(1).Interior.Color = RGB(242, 242, 242)
        .Columns("B:C").NumberFormat = "$#,##0"
    End With
End Sub

Private Sub CreatePerformanceCharts(ws As Worksheet)
    ' Create a simple column chart for regional performance
    Dim chartObj As ChartObject, cht As Chart
    Dim dataRange As Range
    
    ' Find regional data for chart
    Dim regionStart As Long, regionEnd As Long
    regionStart = FindReportSectionStart(ws, "REGIONAL PERFORMANCE")
    regionEnd = FindReportSectionEnd(ws, regionStart)
    
    If regionStart = 0 Or regionEnd = 0 Then Exit Sub
    
    ' Create chart to the right of data
    Set chartObj = ws.ChartObjects.Add(Left:=450, Top:=50, Width:=300, Height:=200)
    Set cht = chartObj.Chart
    
    ' Set up chart data
    Set dataRange = ws.Range("A" & (regionStart + 2) & ":B" & regionEnd)
    
    With cht
        .SetSourceData dataRange
        .ChartType = xlColumnClustered
        .HasTitle = True
        .ChartTitle.Text = "Sales by Region"
        .ChartTitle.Font.Size = 12
        .ChartTitle.Font.Bold = True
        
        ' Format chart area
        .ChartArea.Fill.ForeColor.RGB = RGB(255, 255, 255)
        .ChartArea.Border.LineStyle = xlContinuous
        .ChartArea.Border.Weight = xlThin
        
        ' Format plot area
        .PlotArea.Fill.ForeColor.RGB = RGB(248, 248, 248)
        
        ' Format axes
        If .HasAxis(xlCategory) Then
            .Axes(xlCategory).TickLabels.Font.Size = 9
        End If
        
        If .HasAxis(xlValue) Then
            .Axes(xlValue).TickLabels.Font.Size = 9
            .Axes(xlValue).TickLabels.NumberFormat = "$#,##0"
        End If
        
        ' Remove legend if only one series
        .HasLegend = False
    End With
End Sub

Private Function FindReportSectionStart(ws As Worksheet, sectionName As String) As Long
    Dim i As Long
    For i = 1 To 100 ' Limit search to reasonable range
        If InStr(1, ws.Cells(i, 1).Value, sectionName, vbTextCompare) > 0 Then
            FindReportSectionStart = i
            Exit Function
        End If
    Next i
    FindReportSectionStart = 0
End Function

Private Function FindReportSectionEnd(ws As Worksheet, startRow As Long) As Long
    Dim i As Long
    For i = startRow + 1 To startRow + 20 ' Reasonable section size
        If ws.Cells(i, 1).Value = "" Or _
           InStr(1, ws.Cells(i, 1).Value, "PERFORMANCE", vbTextCompare) > 0 Then
            FindReportSectionEnd = i - 1
            Exit Function
        End If
    Next i
    FindReportSectionEnd = startRow + 10 ' Default fallback
End Function

Private Sub ApplyFinalFormatting(ws As Worksheet)
    ' Apply final touches and prepare for distribution
    ws.Cells.Select
    ws.Cells.EntireColumn.AutoFit
    
    ' Protect worksheet but allow filtering
    ws.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True, _
              AllowFiltering:=True, AllowSorting:=True
    
    ' Set print area
    Dim lastRow As Long, lastCol As Long
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    
    ws.PageSetup.PrintArea = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol)).Address
    
    ' Set page breaks if needed
    ws.PageSetup.FitToPagesWide = 1
    ws.PageSetup.FitToPagesTall = False
    
    ' Select cell A1 for clean appearance
    ws.Range("A1").Select
End Sub

This formatting module creates professional-looking reports with consistent styling, conditional formatting, and embedded charts. The key is to think about your audience—busy executives who need to quickly identify trends and outliers.

Automated Distribution System

The final piece of our system handles report distribution. This module can save reports in various formats and email them to stakeholders automatically.

' Module: ReportDistributor
Option Explicit

Public Sub SendReportEmail()
    Dim reportPath As String, pdfPath As String
    
    ' Save Excel version for backup
    reportPath = SaveExcelReport()
    
    ' Create PDF version for email
    pdfPath = SavePDFReport()
    
    ' Send email with both attachments
    Call SendEmailWithAttachments(reportPath, pdfPath)
    
    Debug.Print "Report distributed successfully to stakeholders"
End Sub

Private Function SaveExcelReport() As String
    Dim ws As Worksheet, filePath As String, fileName As String
    Set ws = ThisWorkbook.Worksheets("WeeklyReport")
    
    ' Create filename with timestamp
    fileName = "Weekly_Sales_Report_" & Format(Date, "yyyy-mm-dd") & ".xlsx"
    filePath = Environ("USERPROFILE") & "\Documents\" & fileName
    
    ' Copy report to new workbook
    Dim newWb As Workbook
    Set newWb = Workbooks.Add
    
    ws.Copy Before:=newWb.Sheets(1)
    newWb.Sheets("Sheet1").Delete
    
    ' Save the new workbook
    Application.DisplayAlerts = False
    newWb.SaveAs Filename:=filePath, FileFormat:=xlOpenXMLWorkbook
    newWb.Close SaveChanges:=False
    Application.DisplayAlerts = True
    
    SaveExcelReport = filePath
End Function

Private Function SavePDFReport() As String
    Dim ws As Worksheet, filePath As String, fileName As String
    Set ws = ThisWorkbook.Worksheets("WeeklyReport")
    
    fileName = "Weekly_Sales_Report_" & Format(Date, "yyyy-mm-dd") & ".pdf"
    filePath = Environ("USERPROFILE") & "\Documents\" & fileName
    
    ' Export as PDF with optimized settings
    ws.ExportAsFixedFormat Type:=xlTypePDF, _
                          Filename:=filePath, _
                          Quality:=xlQualityStandard, _
                          IncludeDocProps:=True, _
                          IgnorePrintAreas:=False, _
                          OpenAfterPublish:=False
    
    SavePDFReport = filePath
End Function

Private Sub SendEmailWithAttachments(excelPath As String, pdfPath As String)
    ' This uses Outlook automation - requires Outlook to be installed
    On Error GoTo EmailError
    
    Dim outlookApp As Object, mailItem As Object
    Set outlookApp = CreateObject("Outlook.Application")
    Set mailItem = outlookApp.CreateItem(0) ' olMailItem = 0
    
    With mailItem
        .To = GetEmailRecipients()
        .Subject = "Weekly Sales Report - " & Format(Date, "mmmm dd, yyyy")
        .Body = CreateEmailBody()
        
        ' Attach both files
        .Attachments.Add excelPath
        .Attachments.Add pdfPath
        
        ' Send automatically or display for review
        If GetAutoSendSetting() Then
            .Send
        Else
            .Display ' Shows email for manual review before sending
        End If
    End With
    
    Exit Sub
    
EmailError:
    Debug.Print "Error sending email: " & Err.Description
    MsgBox "Could not send email automatically. Please send manually." & vbNewLine & _
           "Excel file: " & excelPath & vbNewLine & _
           "PDF file: " & pdfPath, vbExclamation
End Sub

Private Function GetEmailRecipients() As String
    ' In production, this would read from a configuration worksheet or registry
    ' For now, return a semicolon-separated list
    GetEmailRecipients = "sales.manager@company.com;regional.director@company.com;ceo@company.com"
End Function

Private Function CreateEmailBody() As String
    Dim body As String
    
    body = "Dear Team," & vbNewLine & vbNewLine
    body = body & "Please find attached the weekly sales performance report for the week ending "
    body = body & Format(Date, "mmmm dd, yyyy") & "." & vbNewLine & vbNewLine
    body = body & "Key Highlights:" & vbNewLine
    body = body & "• Report generated automatically at " & Format(Now, "h:mm AM/PM") & vbNewLine
    body = body & "• Data includes regional, product, and individual performance metrics" & vbNewLine
    body = body & "• Trend analysis covers the last 4 weeks" & vbNewLine & vbNewLine
    body = body & "The report is available in both Excel (.xlsx) and PDF formats." & vbNewLine & vbNewLine
    body = body & "Please contact the data team if you have any questions about the data or methodology." & vbNewLine & vbNewLine
    body = body & "Best regards," & vbNewLine
    body = body & "Automated Reporting System"
    
    CreateEmailBody = body
End Function

Private Function GetAutoSendSetting() As Boolean
    ' Configuration setting - in production, store in worksheet or registry
    ' For safety, default to manual review
    GetAutoSendSetting = False
End Function

' Additional utility function for saving to network drive
Public Sub SaveToNetworkLocation()
    On Error GoTo NetworkError
    
    Dim ws As Worksheet, networkPath As String, fileName As String
    Set ws = ThisWorkbook.Worksheets("WeeklyReport")
    
    ' Network path - modify for your environment
    networkPath = "\\shared-server\reports\sales\"
    fileName = "Weekly_Sales_Report_" & Format(Date, "yyyy-mm-dd") & ".xlsx"
    
    ' Check if network path exists
    If Dir(networkPath, vbDirectory) = "" Then
        MsgBox "Network location not available: " & networkPath, vbExclamation
        Exit Sub
    End If
    
    ' Copy report to network location
    Dim newWb As Workbook
    Set newWb = Workbooks.Add
    ws.Copy Before:=newWb.Sheets(1)
    newWb.Sheets("Sheet1").Delete
    
    Application.DisplayAlerts = False
    newWb.SaveAs Filename:=networkPath & fileName, FileFormat:=xlOpenXMLWorkbook
    newWb.Close SaveChanges:=False
    Application.DisplayAlerts = True
    
    Debug.Print "Report saved to network location: " & networkPath & fileName
    Exit Sub
    
NetworkError:
    Debug.Print "Error saving to network: " & Err.Description
    MsgBox "Could not save to network location. File saved locally instead.", vbInformation
End Sub

This distribution module handles the practical aspects of getting reports to stakeholders. The email automation requires Outlook, but you could adapt it for other email systems or web services.

Hands-On Exercise: Building Your Complete System

Now let's put everything together in a real-world scenario. You'll build a complete automated reporting system for a fictional company's sales data.

Setup: Create a new workbook called "Sales_Reporting_System.xlsm" and add the following worksheets:

• RawSalesData (your source data)
• ProcessedData (will be created automatically)
• Metrics (will be created automatically)
• WeeklyReport (will be created automatically)
• Configuration (for storing settings)

Step 1: Create sample data in the RawSalesData worksheet:

Date        | Region    | Salesperson | Product     | Amount | Quantity
2024-01-08  | North     | Alice Smith | Widget A    | 1200   | 4
2024-01-09  | South     | Bob Jones   | Widget B    | 800    | 2
2024-01-09  | East      | Carol Davis | Widget A    | 1500   | 5
2024-01-10  | West      | Dave Wilson | Widget C    | 950    | 3
2024-01-10  | North     | Alice Smith | Widget B    | 750    | 3

Add at least 50 rows of data covering the last month, varying the dates, regions, salespeople, and products realistically.

Step 2: Implement the complete system by copying all the modules we've built and testing each component individually:

1. Test data processing: DataProcessor.ImportAndCleanData
2. Test calculations: BusinessLogic.CalculateMetrics
3. Test formatting: ReportFormatter.CreateFormattedReport
4. Test distribution: ReportDistributor.SaveExcelReport

Step 3: Create a simple user interface by adding a button to your main worksheet:

Private Sub cmdGenerateReport_Click()
    Call MainController.GenerateWeeklySalesReport
End Sub

Step 4: Add configuration options in your Configuration worksheet:

Setting               | Value
EmailRecipients      | your.email@company.com
AutoSend             | FALSE
NetworkPath          | C:\Reports\
IncludeTrends        | TRUE
ChartType            | Column

Then modify your modules to read these settings instead of using hardcoded values.

Step 5: Test error conditions:

• Remove some data to test validation
• Try running with no data
• Test with invalid email settings
• Verify the system handles each error gracefully

Common Mistakes & Troubleshooting

Performance Issues: The most common mistake is processing data inefficiently. If your system becomes slow, avoid cell-by-cell operations in loops. Instead, read ranges into arrays, process the arrays, and write back to ranges:

' Slow - cell by cell processing
For i = 2 To lastRow
    If ws.Cells(i, 2) = "North" Then
        totalSales = totalSales + ws.Cells(i, 5)
    End If
Next i

' Fast - array processing
Dim dataArray As Variant
dataArray = ws.Range("A2:F" & lastRow).Value

For i = 1 To UBound(dataArray, 1)
    If dataArray(i, 2) = "North" Then
        totalSales = totalSales + dataArray(i, 5)
    End If
Next i

Runtime Errors: The second most common issue is runtime errors when worksheets or data don't exist. Always use error handling and validation:

On Error Resume Next
Set ws = ThisWorkbook.Worksheets("DataSheet")
On Error GoTo 0

If ws Is Nothing Then
    MsgBox "Required worksheet 'DataSheet' not found!", vbCritical
    Exit Sub
End If

Email Problems: Outlook automation fails frequently due to security settings. Have a fallback plan:

On Error GoTo EmailError
' ... outlook automation code ...
Exit Sub

EmailError:
    ' Save files and show manual instructions
    MsgBox "Email automation failed. Reports saved to: " & filePath

Data Type Mismatches: Always validate data types before processing:

If IsDate(ws.Cells(i, 1)) And IsNumeric(ws.Cells(i, 5)) Then
    ' Process the row
Else
    Debug.Print "Skipping row " & i & ": Invalid data types"
End If

Memory Issues: Large datasets can cause memory problems. Clear object variables and use Application.ScreenUpdating = False during processing:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

' ... processing code ...

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

' Clean up objects
Set ws = Nothing
Set rng = Nothing

Summary & Next Steps

You've now built a complete automated reporting system that can handle the entire lifecycle from raw data to distributed reports. The modular architecture you've implemented provides several key benefits:

Maintainability: Each module has a clear responsibility, making updates and debugging straightforward. When business requirements change, you'll know exactly where to make modifications.

Reliability: The error handling and validation routines ensure your system fails gracefully and provides useful diagnostic information when problems occur.

Scalability: The data processing routines can handle varying data sizes, and the calculation engine can easily accommodate new metrics as requirements evolve.

User-Friendly: The automated distribution and professional formatting means stakeholders get reports they actually want to use.

Next Steps for Enhancement:

1. Database Integration: Replace worksheet-based data sources with direct database connections using ADO or ODBC for real-time data access.

2. Advanced Analytics: Add statistical analysis, forecasting, and trend detection to provide predictive insights rather than just historical reporting.

3. Web Integration: Implement REST API connections to pull data from CRM systems, web analytics platforms, or cloud databases.

4. Dashboard Creation: Build interactive dashboards using Excel's chart and form controls, or export data to Power BI for advanced visualization.

5. Scheduling: Integrate with Windows Task Scheduler or use Excel's Application.OnTime method to run reports automatically at specified intervals.

6. Version Control: Implement data versioning to track changes over time and provide audit trails for regulatory compliance.

The foundation you've built can support all these enhancements without major architectural changes. Start with the enhancement that provides the most immediate value to your organization, and build from there.

Remember: the best automated reporting system is one that actually gets used. Focus on solving real business problems with reliable, user-friendly solutions, and your stakeholders will quickly wonder how they ever managed without it.