UtilityModule.bas

Attribute VB_Name = "UtilityModule"
' Manufacturing Workflow Scheduler - Utility Module
' Created: April 2025
'
' This module contains utility functions and error handling for the application

Option Explicit

' Application constants
Public Const ERROR_LOG_FILE As String = "ErrorLog.txt"

' Log an error to the log file
Public Sub LogError(moduleName As String, procedureName As String, errNumber As Long, errDescription As String)
    Dim fileNum As Integer
    Dim logPath As String
    
    ' Get log path
    logPath = ThisWorkbook.Path & "\" & ERROR_LOG_FILE
    
    ' Open log file
    fileNum = FreeFile
    On Error Resume Next
    Open logPath For Append As #fileNum
    
    ' Write error info
    Print #fileNum, Format(Now, "yyyy-mm-dd hh:mm:ss") & " - " & _
                   "Module: " & moduleName & " - " & _
                   "Procedure: " & procedureName & " - " & _
                   "Error " & errNumber & ": " & errDescription
    
    ' Close file
    Close #fileNum
End Sub

' Standard error handler that logs errors
Public Sub StandardErrorHandler(moduleName As String, procedureName As String, _
                                errNumber As Long, errDescription As String, _
                                Optional showMsg As Boolean = True)
    ' Log error
    LogError moduleName, procedureName, errNumber, errDescription
    
    ' Show message if requested
    If showMsg Then
        MsgBox "Error in " & moduleName & "." & procedureName & vbCrLf & _
               "Error " & errNumber & ": " & errDescription, vbExclamation, "Error"
    End If
End Sub

' Calculate the critical path for a workflow
Public Function CalculateCriticalPath(workflowSteps As Collection) As Collection
    Dim criticalPath As New Collection
    Dim stepMap As Object
    Dim forwardPass As Object
    Dim backwardPass As Object
    Dim slack As Object
    
    Set stepMap = CreateObject("Scripting.Dictionary")
    Set forwardPass = CreateObject("Scripting.Dictionary")
    Set backwardPass = CreateObject("Scripting.Dictionary")
    Set slack = CreateObject("Scripting.Dictionary")
    
    ' Create step map for easier access
    Dim step As Variant
    For Each step In workflowSteps
        stepMap.Add step("StepID"), step
    Next step
    
    ' Forward pass - Calculate earliest start and finish times
    Dim stepsWithoutPrereqs As New Collection
    
    ' Find steps with no prerequisites
    For Each step In workflowSteps
        If Trim(step("Prerequisites")) = "" Then
            stepsWithoutPrereqs.Add step("StepID")
            
            ' Initialize earliest start/finish
            Dim stepDict As Object
            Set stepDict = CreateObject("Scripting.Dictionary")
            stepDict.Add "EarliestStart", 0
            stepDict.Add "EarliestFinish", CDbl(step("Duration")) + CDbl(step("SetupTime"))
            forwardPass.Add step("StepID"), stepDict
        End If
    Next step
    
    ' Process remaining steps
    Do While True
        Dim processed As Boolean
        processed = False
        
        For Each step In workflowSteps
            ' Skip already processed steps
            If forwardPass.Exists(step("StepID")) Then
                GoTo NextStep
            End If
            
            ' Check if all prerequisites are processed
            Dim allPrereqsProcessed As Boolean
            allPrereqsProcessed = True
            
            If Trim(step("Prerequisites")) <> "" Then
                Dim prereqs As Variant
                prereqs = Split(step("Prerequisites"), ",")
                
                Dim i As Long
                For i = 0 To UBound(prereqs)
                    Dim prereq As String
                    prereq = Trim(prereqs(i))
                    
                    If Not forwardPass.Exists(prereq) Then
                        allPrereqsProcessed = False
                        Exit For
                    End If
                Next i
            End If
            
            If allPrereqsProcessed Then
                ' Find maximum earliest finish of prerequisites
                Dim maxEarliestFinish As Double
                maxEarliestFinish = 0
                
                If Trim(step("Prerequisites")) <> "" Then
                    For i = 0 To UBound(prereqs)
                        prereq = Trim(prereqs(i))
                        
                        If forwardPass(prereq)("EarliestFinish") > maxEarliestFinish Then
                            maxEarliestFinish = forwardPass(prereq)("EarliestFinish")
                        End If
                    Next i
                End If
                
                ' Calculate earliest start/finish
                Set stepDict = CreateObject("Scripting.Dictionary")
                stepDict.Add "EarliestStart", maxEarliestFinish
                stepDict.Add "EarliestFinish", maxEarliestFinish + CDbl(step("Duration")) + CDbl(step("SetupTime"))
                forwardPass.Add step("StepID"), stepDict
                
                processed = True
            End If
NextStep:
        Next step
        
        ' If no progress was made, exit loop
        If Not processed Then
            Exit Do
        End If
    Loop
    
    ' Backward pass - Calculate latest start and finish times
    ' Find the maximum earliest finish time (project completion)
    Dim maxFinish As Double
    maxFinish = 0
    
    For Each key In forwardPass.Keys
        If forwardPass(key)("EarliestFinish") > maxFinish Then
            maxFinish = forwardPass(key)("EarliestFinish")
        End If
    Next key
    
    ' Initialize backward pass for steps with no successors
    Dim stepsWithSuccessors As New Collection
    On Error Resume Next
    
    For Each step In workflowSteps
        If Trim(step("Prerequisites")) <> "" Then
            Dim prerequisitesList As Variant
            prerequisitesList = Split(step("Prerequisites"), ",")
            
            For i = 0 To UBound(prerequisitesList)
                Dim prerequisite As String
                prerequisite = Trim(prerequisitesList(i))
                stepsWithSuccessors.Add prerequisite, prerequisite
            Next i
        End If
    Next step
    
    On Error GoTo 0
    
    ' Find steps with no successors
    For Each step In workflowSteps
        On Error Resume Next
        Dim testStep As String
        testStep = stepsWithSuccessors(step("StepID"))
        
        If Err.Number <> 0 Then
            ' This step has no successors
            Set stepDict = CreateObject("Scripting.Dictionary")
            stepDict.Add "LatestFinish", maxFinish
            stepDict.Add "LatestStart", maxFinish - CDbl(step("Duration")) - CDbl(step("SetupTime"))
            backwardPass.Add step("StepID"), stepDict
        End If
        On Error GoTo 0
    Next step
    
    ' Process remaining steps in backward pass
    Do While True
        processed = False
        
        For Each step In workflowSteps
            ' Skip already processed steps
            If backwardPass.Exists(step("StepID")) Then
                GoTo NextStepBackward
            End If
            
            ' Check if all successors are processed
            Dim allSuccessorsProcessed As Boolean
            allSuccessorsProcessed = True
            
            ' Find all steps that have this step as a prerequisite
            For Each otherStep In workflowSteps
                If Trim(otherStep("Prerequisites")) <> "" Then
                    prereqs = Split(otherStep("Prerequisites"), ",")
                    
                    For i = 0 To UBound(prereqs)
                        If Trim(prereqs(i)) = step("StepID") Then
                            ' This step is a prerequisite for otherStep
                            If Not backwardPass.Exists(otherStep("StepID")) Then
                                allSuccessorsProcessed = False
                                Exit For
                            End If
                        End If
                    Next i
                    
                    If Not allSuccessorsProcessed Then
                        Exit For
                    End If
                End If
            Next otherStep
            
            If allSuccessorsProcessed Then
                ' Find minimum latest start of successors
                Dim minLatestStart As Double
                minLatestStart = maxFinish
                
                ' Find all steps that have this step as a prerequisite
                For Each otherStep In workflowSteps
                    If Trim(otherStep("Prerequisites")) <> "" Then
                        prereqs = Split(otherStep("Prerequisites"), ",")
                        
                        For i = 0 To UBound(prereqs)
                            If Trim(prereqs(i)) = step("StepID") Then
                                ' This step is a prerequisite for otherStep
                                If backwardPass(otherStep("StepID"))("LatestStart") < minLatestStart Then
                                    minLatestStart = backwardPass(otherStep("StepID"))("LatestStart")
                                End If
                            End If
                        Next i
                    End If
                Next otherStep
                
                ' Calculate latest start/finish
                Set stepDict = CreateObject("Scripting.Dictionary")
                stepDict.Add "LatestFinish", minLatestStart
                stepDict.Add "LatestStart", minLatestStart - CDbl(step("Duration")) - CDbl(step("SetupTime"))
                backwardPass.Add step("StepID"), stepDict
                
                processed = True
            End If
NextStepBackward:
        Next step
        
        ' If no progress was made, exit loop
        If Not processed Then
            Exit Do
        End If
    Loop
    
    ' Calculate slack time and identify critical path
    For Each key In forwardPass.Keys
        Dim slackTime As Double
        slackTime = backwardPass(key)("LatestStart") - forwardPass(key)("EarliestStart")
        
        slack.Add key, slackTime
        
        ' Steps with zero slack are on the critical path
        If slackTime = 0 Then
            criticalPath.Add key
        End If
    Next key
    
    ' Return the critical path
    Set CalculateCriticalPath = criticalPath
End Function

' Resource leveling algorithm
Public Sub LevelResources(resourceName As String, Optional maxUtilization As Double = 100)
    Dim wsSchedule As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim resourceSteps As Collection
    Dim currentDate As Date
    Dim endDate As Date
    
    ' Get reference to schedule sheet
    Set wsSchedule = ThisWorkbook.Sheets("Schedule")
    lastRow = wsSchedule.Cells(wsSchedule.Rows.Count, 1).End(xlUp).Row
    
    ' Collect all steps for this resource
    Set resourceSteps = New Collection
    
    For i = 2 To lastRow
        If wsSchedule.Cells(i, 6).Value = resourceName Then
            Dim step As Object
            Set step = CreateObject("Scripting.Dictionary")
            step.Add "Row", i
            step.Add "WorkOrder", wsSchedule.Cells(i, 1).Value
            step.Add "StepID", wsSchedule.Cells(i, 3).Value
            step.Add "StartDate", wsSchedule.Cells(i, 7).Value
            step.Add "EndDate", wsSchedule.Cells(i, 8).Value
            step.Add "Duration", wsSchedule.Cells(i, 9).Value
            
            resourceSteps.Add step
        End If
    Next i
    
    ' Sort steps by start date
    SortStepsByDate resourceSteps
    
    ' Find overlapping tasks and adjust
    Dim j As Long
    
    For i = 1 To resourceSteps.Count
        Dim currentStep As Object
        Set currentStep = resourceSteps(i)
        
        ' Check for overlap with later tasks
        For j = i + 1 To resourceSteps.Count
            Dim nextStep As Object
            Set nextStep = resourceSteps(j)
            
            ' Check if tasks overlap
            If currentStep("EndDate") > nextStep("StartDate") Then
                ' Move the next task to start after the current task
                Dim newStartDate As Date
                newStartDate = currentStep("EndDate")
                
                ' Update the schedule
                wsSchedule.Cells(nextStep("Row"), 7).Value = newStartDate
                wsSchedule.Cells(nextStep("Row"), 8).Value = DateAdd("d", nextStep("Duration"), newStartDate)
                
                ' Update the step in our collection
                nextStep("StartDate") = newStartDate
                nextStep("EndDate") = DateAdd("d", nextStep("Duration"), newStartDate)
            End If
        Next j
    Next i
End Sub

' Sort steps by date
Private Sub SortStepsByDate(steps As Collection)
    Dim i As Long, j As Long
    Dim temp As Object
    
    ' Simple bubble sort
    For i = 1 To steps.Count - 1
        For j = i + 1 To steps.Count
            If steps(i)("StartDate") > steps(j)("StartDate") Then
                Set temp = steps(i)
                steps.Remove i
                steps.Add temp, , i
            End If
        Next j
    Next i
End Sub

' Parse duration string to hours
Public Function ParseDuration(durationString As String) As Double
    ' Convert string like "2d 4h" to hours
    Dim result As Double
    Dim parts As Variant
    Dim i As Long
    
    ' Split by spaces
    parts = Split(durationString, " ")
    
    For i = 0 To UBound(parts)
        Dim value As String
        Dim unit As String
        
        value = ""
        
        ' Extract numeric part
        Dim j As Long
        For j = 1 To Len(parts(i))
            If IsNumeric(Mid(parts(i), j, 1)) Then
                value = value & Mid(parts(i), j, 1)
            Else
                unit = Mid(parts(i), j)
                Exit For
            End If
        Next j
        
        ' Convert to hours based on unit
        If LCase(unit) = "d" Then
            result = result + CDbl(value) * 24
        ElseIf LCase(unit) = "h" Then
            result = result + CDbl(value)
        ElseIf LCase(unit) = "m" Then
            result = result + CDbl(value) / 60
        End If
    Next i
    
    ParseDuration = result
End Function

' Format hours to duration string
Public Function FormatDuration(hours As Double) As String
    Dim days As Long
    Dim remainingHours As Double
    Dim result As String
    
    ' Calculate days and remaining hours
    days = Int(hours / 24)
    remainingHours = hours - (days * 24)
    
    ' Format result
    If days > 0 Then
        result = days & "d"
    End If
    
    If remainingHours > 0 Then
        If result <> "" Then result = result & " "
        result = result & Format(remainingHours, "0.0") & "h"
    End If
    
    If result = "" Then
        result = "0h"
    End If
    
    FormatDuration = result
End Function

' Create a copy of a dictionary object
Public Function CloneDictionary(dict As Object) As Object
    Dim newDict As Object
    Set newDict = CreateObject("Scripting.Dictionary")
    
    Dim key As Variant
    For Each key In dict.Keys
        If TypeName(dict(key)) = "Dictionary" Then
            ' Clone nested dictionary
            newDict.Add key, CloneDictionary(dict(key))
        Else
            ' Add simple value
            newDict.Add key, dict(key)
        End If
    Next key
    
    Set CloneDictionary = newDict
End Function

' Convert Excel date to string
Public Function DateToString(dt As Date) As String
    DateToString = Format(dt, "yyyy-mm-dd")
End Function

' Convert string to Excel date
Public Function StringToDate(str As String) As Date
    If IsDate(str) Then
        StringToDate = CDate(str)
    Else
        StringToDate = DateValue("1900-01-01")
    End If
End Function