ReportingModule.bas

Attribute VB_Name = "ReportingModule"
' Manufacturing Workflow Scheduler - Reporting Module
' Created: April 2025
'
' This module contains functions for generating reports and analytics
' on the manufacturing workflow schedule

Option Explicit

' Generate a basic schedule summary report
Public Sub GenerateScheduleSummary()
    Dim wsSchedule As Worksheet
    Dim wsReport As Worksheet
    Dim lastRow As Long
    Dim workOrders As Collection
    Dim i As Long
    
    ' Get references to sheets
    Set wsSchedule = ThisWorkbook.Sheets("Schedule")
    Set wsReport = ThisWorkbook.Sheets("Reports")
    
    ' Clear report sheet
    wsReport.UsedRange.Clear
    
    ' Get data from schedule
    lastRow = wsSchedule.Cells(wsSchedule.Rows.Count, 1).End(xlUp).Row
    
    ' Get unique work orders
    Set workOrders = New Collection
    On Error Resume Next
    For i = 2 To lastRow
        workOrders.Add wsSchedule.Cells(i, 1).Value, CStr(wsSchedule.Cells(i, 1).Value)
    Next i
    On Error GoTo 0
    
    ' Create summary headers
    wsReport.Range("A1").Value = "Work Order"
    wsReport.Range("B1").Value = "Product"
    wsReport.Range("C1").Value = "Earliest Start"
    wsReport.Range("D1").Value = "Latest Finish"
    wsReport.Range("E1").Value = "Total Duration (Days)"
    wsReport.Range("F1").Value = "Step Count"
    wsReport.Range("G1").Value = "Status"
    
    Dim row As Long
    row = 2
    
    Dim workOrder As Variant
    For Each workOrder In workOrders
        Dim woProduct As String
        Dim earliestStart As Date
        Dim latestFinish As Date
        Dim totalDuration As Double
        Dim stepCount As Long
        
        ' Initialize values
        earliestStart = DateValue("2099-12-31")
        latestFinish = DateValue("1900-01-01")
        totalDuration = 0
        stepCount = 0
        
        ' Find data for this work order
        For i = 2 To lastRow
            If wsSchedule.Cells(i, 1).Value = workOrder Then
                ' Get product
                woProduct = wsSchedule.Cells(i, 2).Value
                
                ' Check earliest start
                If wsSchedule.Cells(i, 7).Value < earliestStart Then
                    earliestStart = wsSchedule.Cells(i, 7).Value
                End If
                
                ' Check latest finish
                If wsSchedule.Cells(i, 8).Value > latestFinish Then
                    latestFinish = wsSchedule.Cells(i, 8).Value
                End If
                
                ' Add duration
                totalDuration = totalDuration + wsSchedule.Cells(i, 9).Value
                
                ' Count step
                stepCount = stepCount + 1
            End If
        Next i
        
        ' Write summary row
        wsReport.Cells(row, 1).Value = workOrder
        wsReport.Cells(row, 2).Value = woProduct
        wsReport.Cells(row, 3).Value = earliestStart
        wsReport.Cells(row, 4).Value = latestFinish
        wsReport.Cells(row, 5).Value = totalDuration
        wsReport.Cells(row, 6).Value = stepCount
        
        ' Calculate status based on due date
        Dim status As String
        Dim wsData As Worksheet
        Set wsData = ThisWorkbook.Sheets("ImportedData")
        Dim dueDate As Date
        dueDate = GetWorkOrderDueDate(wsData, workOrder)
        
        If latestFinish <= dueDate Then
            status = "On Schedule"
        Else
            status = "Delayed"
        End If
        
        wsReport.Cells(row, 7).Value = status
        
        row = row + 1
    Next workOrder
    
    ' Format
    wsReport.Range("A1:G1").Font.Bold = True
    wsReport.Range("A1:G1").Interior.Color = RGB(200, 200, 200)
    wsReport.Range("C:D").NumberFormat = "yyyy-mm-dd"
    wsReport.Range("E:E").NumberFormat = "0.00"
    wsReport.UsedRange.Columns.AutoFit
    
    ' Create table
    If Not wsReport.ListObjects.Count > 0 Then
        wsReport.ListObjects.Add(xlSrcRange, wsReport.UsedRange, , xlYes).Name = "SummaryTable"
    Else
        wsReport.ListObjects(1).Resize wsReport.UsedRange
    End If
    
    ' Add conditional formatting for status
    Dim statusRange As Range
    Set statusRange = wsReport.Range("G2:G" & row - 1)
    
    statusRange.FormatConditions.Delete
    
    ' Add rule for "Delayed" status
    statusRange.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""Delayed"""
    statusRange.FormatConditions(1).Interior.Color = RGB(255, 200, 200)
    
    ' Add rule for "On Schedule" status
    statusRange.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""On Schedule"""
    statusRange.FormatConditions(2).Interior.Color = RGB(200, 255, 200)
    
    ' Activate report sheet
    wsReport.Activate
    
    MsgBox "Summary report generated successfully.", vbInformation, "Report Generated"
End Sub

' Get due date for a work order
Private Function GetWorkOrderDueDate(wsData As Worksheet, workOrder As String) As Date
    Dim lastRow As Long
    Dim i As Long
    
    lastRow = wsData.Cells(wsData.Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To lastRow
        If wsData.Cells(i, 1).Value = workOrder Then
            GetWorkOrderDueDate = wsData.Cells(i, 5).Value
            Exit Function
        End If
    Next i
    
    ' Default to far future date if not found
    GetWorkOrderDueDate = DateValue("2099-12-31")
End Function

' Generate resource utilization report
Public Sub GenerateResourceUtilizationReport()
    Dim wsSchedule As Worksheet
    Dim wsReport As Worksheet
    Dim lastRow As Long
    Dim resources As Collection
    Dim i As Long
    
    ' Get references to sheets
    Set wsSchedule = ThisWorkbook.Sheets("Schedule")
    
    ' Create resource report sheet if it doesn't exist
    If Not SheetExists("ResourceReport") Then
        ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = "ResourceReport"
    End If
    Set wsReport = ThisWorkbook.Sheets("ResourceReport")
    
    ' Clear report sheet
    wsReport.UsedRange.Clear
    
    ' Get data from schedule
    lastRow = wsSchedule.Cells(wsSchedule.Rows.Count, 1).End(xlUp).Row
    
    ' Get unique resources
    Set resources = New Collection
    On Error Resume Next
    For i = 2 To lastRow
        resources.Add wsSchedule.Cells(i, 6).Value, CStr(wsSchedule.Cells(i, 6).Value)
    Next i
    On Error GoTo 0
    
    ' Create report headers
    wsReport.Range("A1").Value = "Resource"
    wsReport.Range("B1").Value = "Total Days"
    wsReport.Range("C1").Value = "Work Orders"
    wsReport.Range("D1").Value = "Steps"
    wsReport.Range("E1").Value = "Utilization (%)"
    
    Dim row As Long
    row = 2
    
    ' Get date range for schedule
    Dim startDate As Date
    Dim endDate As Date
    startDate = DateValue("2099-12-31")
    endDate = DateValue("1900-01-01")
    
    For i = 2 To lastRow
        If IsDate(wsSchedule.Cells(i, 7).Value) And wsSchedule.Cells(i, 7).Value < startDate Then
            startDate = wsSchedule.Cells(i, 7).Value
        End If
        
        If IsDate(wsSchedule.Cells(i, 8).Value) And wsSchedule.Cells(i, 8).Value > endDate Then
            endDate = wsSchedule.Cells(i, 8).Value
        End If
    Next i
    
    ' Calculate total schedule days
    Dim totalDays As Long
    totalDays = endDate - startDate + 1
    
    ' Calculate utilization for each resource
    Dim resource As Variant
    For Each resource In resources
        Dim totalResourceDays As Double
        Dim workOrderCount As Long
        Dim stepCount As Long
        Dim workOrders As New Collection
        
        totalResourceDays = 0
        stepCount = 0
        
        ' Calculate total days, work orders, and steps for this resource
        For i = 2 To lastRow
            If wsSchedule.Cells(i, 6).Value = resource Then
                ' Add duration
                totalResourceDays = totalResourceDays + wsSchedule.Cells(i, 9).Value
                
                ' Count step
                stepCount = stepCount + 1
                
                ' Add work order to collection if not already there
                On Error Resume Next
                workOrders.Add wsSchedule.Cells(i, 1).Value, CStr(wsSchedule.Cells(i, 1).Value)
                On Error GoTo 0
            End If
        Next i
        
        ' Calculate utilization
        Dim utilization As Double
        utilization = (totalResourceDays / totalDays) * 100
        
        ' Write report row
        wsReport.Cells(row, 1).Value = resource
        wsReport.Cells(row, 2).Value = totalResourceDays
        wsReport.Cells(row, 3).Value = workOrders.Count
        wsReport.Cells(row, 4).Value = stepCount
        wsReport.Cells(row, 5).Value = utilization
        
        row = row + 1
    Next resource
    
    ' Format
    wsReport.Range("A1:E1").Font.Bold = True
    wsReport.Range("A1:E1").Interior.Color = RGB(200, 200, 200)
    wsReport.Range("B:B").NumberFormat = "0.00"
    wsReport.Range("E:E").NumberFormat = "0.00%"
    wsReport.UsedRange.Columns.AutoFit
    
    ' Create table
    If Not wsReport.ListObjects.Count > 0 Then
        wsReport.ListObjects.Add(xlSrcRange, wsReport.UsedRange, , xlYes).Name = "ResourceTable"
    Else
        wsReport.ListObjects(1).Resize wsReport.UsedRange
    End If
    
    ' Create chart
    CreateResourceUtilizationChart wsReport
    
    ' Activate report sheet
    wsReport.Activate
    
    MsgBox "Resource utilization report generated successfully.", vbInformation, "Report Generated"
End Sub

' Create resource utilization chart
Private Sub CreateResourceUtilizationChart(ws As Worksheet)
    ' Remove existing charts
    Dim chartObj As ChartObject
    For Each chartObj In ws.ChartObjects
        chartObj.Delete
    Next chartObj
    
    ' Create chart
    Set chartObj = ws.ChartObjects.Add(ws.Range("G2").Left, ws.Range("G2").Top, 400, 300)
    
    With chartObj.Chart
        .SetSourceData Source:=ws.Range("A1:B" & ws.Cells(ws.Rows.Count, 1).End(xlUp).Row)
        .ChartType = xlColumnClustered
        .HasTitle = True
        .ChartTitle.Text = "Resource Utilization (Days)"
        .Axes(xlValue).HasTitle = True
        .Axes(xlValue).AxisTitle.Text = "Days"
        .Axes(xlCategory).HasTitle = True
        .Axes(xlCategory).AxisTitle.Text = "Resource"
    End With
    
    ' Create second chart
    Set chartObj = ws.ChartObjects.Add(ws.Range("G2").Left, ws.Range("G2").Top + 350, 400, 300)
    
    With chartObj.Chart
        .SetSourceData Source:=ws.Range("A1:A" & ws.Cells(ws.Rows.Count, 1).End(xlUp).Row & "," & _
                               "E1:E" & ws.Cells(ws.Rows.Count, 1).End(xlUp).Row)
        .ChartType = xlColumnClustered
        .HasTitle = True
        .ChartTitle.Text = "Resource Utilization (%)"
        .Axes(xlValue).HasTitle = True
        .Axes(xlValue).AxisTitle.Text = "Utilization %"
        .Axes(xlCategory).HasTitle = True
        .Axes(xlCategory).AxisTitle.Text = "Resource"
        .Axes(xlValue).MinimumScale = 0
        .Axes(xlValue).MaximumScale = 100
    End With
End Sub

' Generate department workload report
Public Sub GenerateDepartmentWorkloadReport()
    Dim wsSchedule As Worksheet
    Dim wsReport As Worksheet
    Dim lastRow As Long
    Dim departments As Collection
    Dim i As Long
    
    ' Get references to sheets
    Set wsSchedule = ThisWorkbook.Sheets("Schedule")
    
    ' Create department report sheet if it doesn't exist
    If Not SheetExists("DepartmentReport") Then
        ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = "DepartmentReport"
    End If
    Set wsReport = ThisWorkbook.Sheets("DepartmentReport")
    
    ' Clear report sheet
    wsReport.UsedRange.Clear
    
    ' Get data from schedule
    lastRow = wsSchedule.Cells(wsSchedule.Rows.Count, 1).End(xlUp).Row
    
    ' Get unique departments
    Set departments = New Collection
    On Error Resume Next
    For i = 2 To lastRow
        departments.Add wsSchedule.Cells(i, 5).Value, CStr(wsSchedule.Cells(i, 5).Value)
    Next i
    On Error GoTo 0
    
    ' Create report headers
    wsReport.Range("A1").Value = "Department"
    wsReport.Range("B1").Value = "Total Days"
    wsReport.Range("C1").Value = "Work Orders"
    wsReport.Range("D1").Value = "Steps"
    wsReport.Range("E1").Value = "Resources"
    
    Dim row As Long
    row = 2
    
    ' Calculate workload for each department
    Dim department As Variant
    For Each department In departments
        Dim totalDepartmentDays As Double
        Dim workOrderCount As Long
        Dim stepCount As Long
        Dim workOrders As New Collection
        Dim resources As New Collection
        
        totalDepartmentDays = 0
        stepCount = 0
        
        ' Calculate total days, work orders, and steps for this department
        For i = 2 To lastRow
            If wsSchedule.Cells(i, 5).Value = department Then
                ' Add duration
                totalDepartmentDays = totalDepartmentDays + wsSchedule.Cells(i, 9).Value
                
                ' Count step
                stepCount = stepCount + 1
                
                ' Add work order to collection if not already there
                On Error Resume Next
                workOrders.Add wsSchedule.Cells(i, 1).Value, CStr(wsSchedule.Cells(i, 1).Value)
                resources.Add wsSchedule.Cells(i, 6).Value, CStr(wsSchedule.Cells(i, 6).Value)
                On Error GoTo 0
            End If
        Next i
        
        ' Write report row
        wsReport.Cells(row, 1).Value = department
        wsReport.Cells(row, 2).Value = totalDepartmentDays
        wsReport.Cells(row, 3).Value = workOrders.Count
        wsReport.Cells(row, 4).Value = stepCount
        wsReport.Cells(row, 5).Value = resources.Count
        
        row = row + 1
    Next department
    
    ' Format
    wsReport.Range("A1:E1").Font.Bold = True
    wsReport.Range("A1:E1").Interior.Color = RGB(200, 200, 200)
    wsReport.Range("B:B").NumberFormat = "0.00"
    wsReport.UsedRange.Columns.AutoFit
    
    ' Create table
    If Not wsReport.ListObjects.Count > 0 Then
        wsReport.ListObjects.Add(xlSrcRange, wsReport.UsedRange, , xlYes).Name = "DepartmentTable"
    Else
        wsReport.ListObjects(1).Resize wsReport.UsedRange
    End If
    
    ' Create chart
    CreateDepartmentWorkloadChart wsReport
    
    ' Activate report sheet
    wsReport.Activate
    
    MsgBox "Department workload report generated successfully.", vbInformation, "Report Generated"
End Sub

' Create department workload chart
Private Sub CreateDepartmentWorkloadChart(ws As Worksheet)
    ' Remove existing charts
    Dim chartObj As ChartObject
    For Each chartObj In ws.ChartObjects
        chartObj.Delete
    Next chartObj
    
    ' Create chart
    Set chartObj = ws.ChartObjects.Add(ws.Range("G2").Left, ws.Range("G2").Top, 400, 300)
    
    With chartObj.Chart
        .SetSourceData Source:=ws.Range("A1:B" & ws.Cells(ws.Rows.Count, 1).End(xlUp).Row)
        .ChartType = xlColumnClustered
        .HasTitle = True
        .ChartTitle.Text = "Department Workload (Days)"
        .Axes(xlValue).HasTitle = True
        .Axes(xlValue).AxisTitle.Text = "Days"
        .Axes(xlCategory).HasTitle = True
        .Axes(xlCategory).AxisTitle.Text = "Department"
    End With
    
    ' Create pie chart for steps
    Set chartObj = ws.ChartObjects.Add(ws.Range("G2").Left, ws.Range("G2").Top + 350, 400, 300)
    
    With chartObj.Chart
        .SetSourceData Source:=ws.Range("A1:A" & ws.Cells(ws.Rows.Count, 1).End(xlUp).Row & "," & _
                               "D1:D" & ws.Cells(ws.Rows.Count, 1).End(xlUp).Row)
        .ChartType = xlPie
        .HasTitle = True
        .ChartTitle.Text = "Steps by Department"
        .ApplyDataLabels xlDataLabelsShowPercent
        .Legend.Position = xlLegendPositionBottom
    End With
End Sub

' Generate timeline report (Gantt chart)
Public Sub GenerateTimelineReport()
    Dim wsSchedule As Worksheet
    Dim wsTimeline As Worksheet
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim startDate As Date
    Dim endDate As Date
    Dim duration As Long
    
    ' Get references to sheets
    Set wsSchedule = ThisWorkbook.Sheets("Schedule")
    
    ' Create timeline sheet if it doesn't exist
    If Not SheetExists("Timeline") Then
        ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = "Timeline"
    End If
    Set wsTimeline = ThisWorkbook.Sheets("Timeline")
    
    ' Clear timeline sheet
    wsTimeline.UsedRange.Clear
    
    ' Get data from schedule
    lastRow = wsSchedule.Cells(wsSchedule.Rows.Count, 1).End(xlUp).Row
    
    ' Find earliest start date and latest end date
    startDate = DateValue("2099-12-31")
    endDate = DateValue("1900-01-01")
    
    For i = 2 To lastRow
        If IsDate(wsSchedule.Cells(i, 7).Value) And wsSchedule.Cells(i, 7).Value < startDate Then
            startDate = wsSchedule.Cells(i, 7).Value
        End If
        
        If IsDate(wsSchedule.Cells(i, 8).Value) And wsSchedule.Cells(i, 8).Value > endDate Then
            endDate = wsSchedule.Cells(i, 8).Value
        End If
    Next i
    
    ' Calculate duration in days
    duration = endDate - startDate + 1
    
    ' Create timeline headers
    wsTimeline.Range("A1").Value = "Work Order"
    wsTimeline.Range("B1").Value = "Step ID"
    wsTimeline.Range("C1").Value = "Step Name"
    wsTimeline.Range("D1").Value = "Department"
    wsTimeline.Range("E1").Value = "Resource"
    wsTimeline.Range("F1").Value = "Start Date"
    wsTimeline.Range("G1").Value = "End Date"
    
    ' Add dates to timeline
    For j = 0 To duration - 1
        wsTimeline.Cells(1, 8 + j).Value = startDate + j
        wsTimeline.Cells(1, 8 + j).NumberFormat = "d-mmm"
    Next j
    
    ' Add data to timeline
    For i = 2 To lastRow
        ' Copy basic data
        wsTimeline.Cells(i, 1).Value = wsSchedule.Cells(i, 1).Value
        wsTimeline.Cells(i, 2).Value = wsSchedule.Cells(i, 3).Value
        wsTimeline.Cells(i, 3).Value = wsSchedule.Cells(i, 4).Value
        wsTimeline.Cells(i, 4).Value = wsSchedule.Cells(i, 5).Value
        wsTimeline.Cells(i, 5).Value = wsSchedule.Cells(i, 6).Value
        wsTimeline.Cells(i, 6).Value = wsSchedule.Cells(i, 7).Value
        wsTimeline.Cells(i, 7).Value = wsSchedule.Cells(i, 8).Value
        
        ' Add timeline bars
        If IsDate(wsSchedule.Cells(i, 7).Value) And IsDate(wsSchedule.Cells(i, 8).Value) Then
            Dim taskStart As Long
            Dim taskEnd As Long
            
            taskStart = wsSchedule.Cells(i, 7).Value - startDate
            taskEnd = wsSchedule.Cells(i, 8).Value - startDate
            
            ' Fill cells for task duration
            For j = taskStart To taskEnd
                wsTimeline.Cells(i, 8 + j).Interior.Color = RGB(100, 150, 250)
            Next j
            
            ' Add task label
            wsTimeline.Cells(i, 8 + taskStart).Value = wsSchedule.Cells(i, 3).Value
        End If
    Next i
    
    ' Format
    wsTimeline.Range("A1:G1").Font.Bold = True
    wsTimeline.Range("A1:G1").Interior.Color = RGB(200, 200, 200)
    wsTimeline.Range(wsTimeline.Cells(1, 8), wsTimeline.Cells(1, 8 + duration - 1)).Font.Bold = True
    wsTimeline.Range(wsTimeline.Cells(1, 8), wsTimeline.Cells(1, 8 + duration - 1)).Interior.Color = RGB(220, 220, 220)
    wsTimeline.Range("F:G").NumberFormat = "yyyy-mm-dd"
    
    ' Alternate row colors for readability
    For i = 2 To lastRow
        If i Mod 2 = 0 Then
            wsTimeline.Range(wsTimeline.Cells(i, 1), wsTimeline.Cells(i, 7)).Interior.Color = RGB(240, 240, 240)
        End If
    Next i
    
    ' Auto-fit columns
    wsTimeline.Range("A:G").Columns.AutoFit
    wsTimeline.Range(wsTimeline.Cells(1, 8), wsTimeline.Cells(1, 8 + duration - 1)).ColumnWidth = 4
    
    ' Activate timeline sheet
    wsTimeline.Activate
    
    ' Freeze panes for easier navigation
    wsTimeline.Range("H2").Select
    ActiveWindow.FreezePanes = True
    
    MsgBox "Timeline report (Gantt chart) generated successfully.", vbInformation, "Report Generated"
End Sub

' Check if a sheet exists
Private Function SheetExists(sheetName As String) As Boolean
    Dim ws As Worksheet
    
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets(sheetName)
    On Error GoTo 0
    
    SheetExists = Not ws Is Nothing
End Function