' VBA Code to Initialize Workbook and Generate Task Tracker
' Place this code in a standard module (Insert > Module) in the VBA editor.

Option Explicit

' Subroutine to initialize the workbook: create sheets, set up columns, add button
Sub InitializeTaskTracker()
    Dim wsTaskTracker As Worksheet
    Dim wsSettings As Worksheet
    Dim shp As Shape
    Dim btnLeft As Double, btnTop As Double, btnWidth As Double, btnHeight As Double
    Dim btnName As String
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' Attempt to set Task Tracker sheet; if it doesn't exist, create it
    On Error Resume Next
    Set wsTaskTracker = ThisWorkbook.Worksheets("Task Tracker")
    On Error GoTo 0
    If wsTaskTracker Is Nothing Then
        Set wsTaskTracker = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        wsTaskTracker.Name = "Task Tracker"
    Else
        ' Clear existing content
        wsTaskTracker.Cells.Clear
    End If
    
    ' Attempt to set Settings sheet; if it doesn't exist, create it
    On Error Resume Next
    Set wsSettings = ThisWorkbook.Worksheets("Settings")
    On Error GoTo 0
    If wsSettings Is Nothing Then
        Set wsSettings = ThisWorkbook.Worksheets.Add(After:=wsTaskTracker)
        wsSettings.Name = "Settings"
    Else
        ' Clear existing content
        wsSettings.Cells.Clear
    End If
    
    ' Set up columns in Task Tracker
    With wsTaskTracker
        .Range("A1").Value = "Date Offered"
        .Range("B1").Value = "Date Completed"
        .Range("C1").Value = "Time Started"
        .Range("D1").Value = "Time Finished"
        .Range("E1").Value = "Duration (hh:mm:ss)"
        .Range("F1").Value = "Reference Number"
        .Range("G1").Value = "Function/Job Classification"
        .Range("H1").Value = "Remarks/Notes"
        
        ' Format header as bold and apply background color
        With .Range("A1:H1")
            .Font.Bold = True
            .Interior.Color = RGB(200, 200, 200)
        End With
        
        ' Adjust column widths
        .Columns("A:H").AutoFit
    End With
    
    ' Set up Settings sheet
    With wsSettings
        ' Define parameters and labels
        .Range("A1").Value = "Parameter"
        .Range("B1").Value = "Value"
        
        .Range("A2").Value = "Start Time (m/d/yyyy h:mm AM/PM)"
        .Range("B2").Value = "10/5/2023 8:00 AM" ' Example start time
        
        .Range("A3").Value = "First Break Start Time (m/d/yyyy h:mm AM/PM)"
        .Range("B3").Value = "10/5/2023 10:00 AM"
        
        .Range("A4").Value = "First Break Duration (mins)"
        .Range("B4").Value = 13
        
        .Range("A5").Value = "Lunch Break Start Time (m/d/yyyy h:mm AM/PM)"
        .Range("B5").Value = "10/5/2023 12:30 PM"
        
        .Range("A6").Value = "Lunch Break Duration (mins)"
        .Range("B6").Value = 55
        
        .Range("A7").Value = "Last Break Start Time (m/d/yyyy h:mm AM/PM)"
        .Range("B7").Value = "10/5/2023 3:30 PM"
        
        .Range("A8").Value = "Last Break Duration (mins)"
        .Range("B8").Value = 15
        
        ' Headers for Org Codes, Functions, and Remarks
        .Range("C9").Value = "Org Codes"
        .Range("D9").Value = "Function/Job Classification"
        .Range("E9").Value = "Remarks/Notes"
        
        With .Range("C9:E9")
            .Font.Bold = True
            .Interior.Color = RGB(200, 200, 200)
        End With
        
        ' Example Org Codes
        .Range("C10").Value = "ORG001"
        .Range("C11").Value = "ORG002"
        .Range("C12").Value = "ORG003"
        ' Add more Org Codes as needed
        
        ' Example Functions and Remarks
        .Range("D10").Value = "Checking Organization Records"
        .Range("D11").Value = "Creating Organization Records"
        .Range("D12").Value = "Email Management"
        .Range("D13").Value = "PowerBi"
        .Range("D14").Value = "Updating Organization"
        .Range("D15").Value = "Uploading Edocs"
        .Range("D16").Value = "Verifying Temporary Accounts"
        .Range("D17").Value = "OBPI Adhoc"
        
        .Range("E10").Value = "Remark for Checking Organization Records"
        .Range("E11").Value = "Remark for Creating Organization Records"
        .Range("E12").Value = "Remark for Email Management"
        .Range("E13").Value = "Remark for PowerBi"
        .Range("E14").Value = "Remark for Updating Organization"
        .Range("E15").Value = "Remark for Uploading Edocs"
        .Range("E16").Value = "Remark for Verifying Temporary Accounts"
        .Range("E17").Value = "Remark for OBPI Adhoc"
        ' Add more Remarks as needed
        
        ' Format headers for Parameter
        With .Range("A1:B1")
            .Font.Bold = True
            .Interior.Color = RGB(200, 200, 200)
        End With
        
        ' Adjust column widths
        .Columns("A:E").AutoFit
    End With
    
    ' Remove existing "Generate Tasks" button if it exists
    btnName = "btnGenerateTasks"
    On Error Resume Next
    wsTaskTracker.Shapes(btnName).Delete
    On Error GoTo 0
    
    ' Add a button to Task Tracker sheet to run GenerateTasks macro using Shapes.AddFormControl
    With wsTaskTracker
        ' Define button dimensions and position
        btnLeft = 10
        btnTop = 10
        btnWidth = 120
        btnHeight = 30
        
        ' Add the button as a Form Control
        Set shp = .Shapes.AddFormControl(Type:=xlButtonControl, Left:=btnLeft, Top:=btnTop, Width:=btnWidth, Height:=btnHeight)
        With shp
            .OnAction = "GenerateTasks"
            .Name = btnName
            .TextFrame.Characters.Text = "Generate Tasks"
            .TextFrame.HorizontalAlignment = xlHAlignCenter
            .TextFrame.VerticalAlignment = xlVAlignCenter
            .Fill.ForeColor.RGB = RGB(0, 112, 192) ' Optional: Button color
            .Fill.Transparency = 0
            .Line.Visible = msoFalse ' Optional: Remove button border
            .TextFrame.Characters.Font.Color = RGB(255, 255, 255) ' Optional: Text color
            .TextFrame.Characters.Font.Bold = True
        End With
    End With
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "Workbook initialized successfully! Please configure the 'Settings' sheet before generating tasks.", vbInformation
End Sub

' Subroutine to generate tasks based on Settings
Sub GenerateTasks()
    Dim wsTracker As Worksheet
    Dim wsSettings As Worksheet
    
    Set wsTracker = ThisWorkbook.Worksheets("Task Tracker")
    Set wsSettings = ThisWorkbook.Worksheets("Settings")
    
    ' Read Start Time
    Dim startTime As Date
    If IsDate(wsSettings.Range("B2").Value) Then
        startTime = wsSettings.Range("B2").Value
    Else
        MsgBox "Please enter a valid Start Time in the 'Settings' sheet (cell B2).", vbExclamation
        Exit Sub
    End If
    
    ' Read Break Start Times and Durations
    Dim break1Start As Date, break1Duration As Double
    Dim lunchBreakStart As Date, lunchBreakDuration As Double
    Dim break2Start As Date, break2Duration As Double
    
    If IsDate(wsSettings.Range("B3").Value) Then
        break1Start = wsSettings.Range("B3").Value
    Else
        MsgBox "Please enter a valid First Break Start Time in the 'Settings' sheet (cell B3).", vbExclamation
        Exit Sub
    End If
    
    If IsNumeric(wsSettings.Range("B4").Value) Then
        break1Duration = wsSettings.Range("B4").Value
    Else
        MsgBox "Please enter a valid First Break Duration in minutes in the 'Settings' sheet (cell B4).", vbExclamation
        Exit Sub
    End If
    
    If IsDate(wsSettings.Range("B5").Value) Then
        lunchBreakStart = wsSettings.Range("B5").Value
    Else
        MsgBox "Please enter a valid Lunch Break Start Time in the 'Settings' sheet (cell B5).", vbExclamation
        Exit Sub
    End If
    
    If IsNumeric(wsSettings.Range("B6").Value) Then
        lunchBreakDuration = wsSettings.Range("B6").Value
    Else
        MsgBox "Please enter a valid Lunch Break Duration in minutes in the 'Settings' sheet (cell B6).", vbExclamation
        Exit Sub
    End If
    
    If IsDate(wsSettings.Range("B7").Value) Then
        break2Start = wsSettings.Range("B7").Value
    Else
        MsgBox "Please enter a valid Last Break Start Time in the 'Settings' sheet (cell B7).", vbExclamation
        Exit Sub
    End If
    
    If IsNumeric(wsSettings.Range("B8").Value) Then
        break2Duration = wsSettings.Range("B8").Value
    Else
        MsgBox "Please enter a valid Last Break Duration in minutes in the 'Settings' sheet (cell B8).", vbExclamation
        Exit Sub
    End If
    
    ' Read Org Codes from Settings, Column C, starting from C10 down
    Dim orgCodes As Collection
    Set orgCodes = GetOrgCodes(wsSettings, 3, 10) ' Column C, starting from row 10
    
    If orgCodes.Count = 0 Then
        MsgBox "Please enter at least one Org Code in the 'Settings' sheet (column C starting from row 10).", vbExclamation
        Exit Sub
    End If
    
    ' Read Functions and Remarks from Settings, Columns D and E, starting from D10 and E10
    Dim functionsList As Collection
    Dim remarksList As Collection
    Set functionsList = GetFunctionsList(wsSettings, 4, 10) ' Column D
    Set remarksList = GetRemarksList(wsSettings, 5, 10) ' Column E
    
    If functionsList.Count = 0 Then
        MsgBox "Please enter at least one Function/Job Classification in the 'Settings' sheet (column D starting from row 10).", vbExclamation
        Exit Sub
    End If
    
    If remarksList.Count = 0 Then
        MsgBox "Please enter at least one Remark/Notes in the 'Settings' sheet (column E starting from row 10).", vbExclamation
        Exit Sub
    End If
    
    ' Define tasks with their probabilities and duration ranges
    Dim taskNames As Variant
    Dim taskWeights As Variant
    Dim taskMinDurations As Variant
    Dim taskMaxDurations As Variant
    Dim numTasks As Integer
    
    ' Initialize task arrays
    taskNames = Array("Checking Organization Records", "Creating Organization Records", "Email Management", _
                     "PowerBi", "Updating Organization", "Uploading Edocs", "Verifying Temporary Accounts", "OBPI Adhoc")
                     
    taskWeights = Array(80, 10, 80, 40, 30, 60, 80, 10) ' Corresponding to weights
    taskMinDurations = Array(1, 10, 2, 2, 5, 1, 1, 10) ' Random range min (inclusive)
    taskMaxDurations = Array(3, 12, 3, 3, 6, 2, 2, 20) ' Random range max (inclusive)
    
    numTasks = UBound(taskNames) - LBound(taskNames) + 1
    
    ' Validate that task arrays align with Settings entries
    If numTasks <> functionsList.Count Or numTasks <> remarksList.Count Then
        MsgBox "Mismatch between defined tasks and Settings entries. Please ensure they align.", vbExclamation
        Exit Sub
    End If
    
    ' Define total desired duration in minutes (7 hrs 30 mins to 7 hrs 35 mins)
    Dim minTotalDuration As Double, maxTotalDuration As Double
    minTotalDuration = 450 ' 7*60 + 30
    maxTotalDuration = 455 ' 7*60 + 35
    
    ' Initialize variables for task generation
    Dim currentTime As Date
    currentTime = startTime
    Dim totalDuration As Double
    totalDuration = 0
    
    ' Define Breaks as arrays
    Dim breakStarts(1 To 3) As Date
    Dim breakDurations(1 To 3) As Double
    
    breakStarts(1) = break1Start
    breakDurations(1) = break1Duration
    
    breakStarts(2) = lunchBreakStart
    breakDurations(2) = lunchBreakDuration
    
    breakStarts(3) = break2Start
    breakDurations(3) = break2Duration
    
    ' Sort breaks by start time in ascending order
    Dim i As Integer, j As Integer
    Dim tempStart As Date, tempDuration As Double
    For i = 1 To 2
        For j = i + 1 To 3
            If breakStarts(i) > breakStarts(j) Then
                tempStart = breakStarts(i)
                tempDuration = breakDurations(i)
                breakStarts(i) = breakStarts(j)
                breakDurations(i) = breakDurations(j)
                breakStarts(j) = tempStart
                breakDurations(j) = tempDuration
            End If
        Next j
    Next i
    
    ' Initialize next break index
    Dim nextBreak As Integer
    nextBreak = 1
    
    ' Clear previous data in Task Tracker sheet (from row 2 down)
    wsTracker.Range("A2:H" & wsTracker.Rows.Count).ClearContents
    
    ' Initialize random number generator
    Randomize
    
    ' Start generating tasks
    Dim taskRow As Long
    taskRow = 2 ' Start from row 2
    
    Do While totalDuration < minTotalDuration And orgCodes.Count > 0
        Dim selectedOrg As String
        Dim randIndex As Integer
        randIndex = Int((orgCodes.Count) * Rnd + 1)
        selectedOrg = orgCodes.Item(randIndex)
        orgCodes.Remove randIndex
        
        Dim selectedTaskIndex As Integer
        selectedTaskIndex = GetWeightedRandomTaskIndex(taskWeights, numTasks)
        
        Dim selectedTask As String
        selectedTask = taskNames(selectedTaskIndex)
        
        Dim minDuration As Integer, maxDuration As Integer
        minDuration = taskMinDurations(selectedTaskIndex)
        maxDuration = taskMaxDurations(selectedTaskIndex)
        
        Dim taskDuration As Double
        taskDuration = minDuration + Rnd * (maxDuration - minDuration) + (Rnd * 60) / 100
        
        If (totalDuration + taskDuration) > maxTotalDuration Then
            taskDuration = maxTotalDuration - totalDuration
            If taskDuration <= 0 Then Exit Do
        End If
        
        Dim ms As Long
        ms = CLng(Rnd * 1000)
        
        Dim potentialEndTime As Date
        potentialEndTime = DateAdd("s", taskDuration * 60 + ms / 1000, currentTime)
        
        Dim overlap As Boolean
        overlap = False
        For i = nextBreak To 3
            If (currentTime < breakStarts(i) + (breakDurations(i) / (24 * 60))) And (potentialEndTime > breakStarts(i)) Then
                overlap = True
                Exit For
            End If
        Next i
        
        If overlap Then
            For i = nextBreak To 3
                If (currentTime < breakStarts(i) + (breakDurations(i) / (24 * 60))) And (potentialEndTime > breakStarts(i)) Then
                    currentTime = breakStarts(i) + (breakDurations(i) / (24 * 60))
                    nextBreak = i + 1
                    Exit For
                End If
            Next i
            GoTo ContinueLoop
        End If
        
        Dim funcRemark As String
        funcRemark = GetRemarkForFunction(wsSettings, 4, 5, selectedTask)
        
        With wsTracker
            .Range("A" & taskRow).Value = Format(currentTime, "m/d/yyyy") ' Date Offered
            .Range("B" & taskRow).Value = Format(potentialEndTime, "m/d/yyyy") ' Date Completed
            .Range("C" & taskRow).Value = Format(currentTime, "m/d/yyyy h:mm:ss.000 AM/PM") ' Time Started
            .Range("D" & taskRow).Value = Format(potentialEndTime, "m/d/yyyy h:mm:ss.000 AM/PM") ' Time Finished
            .Range("E" & taskRow).Value = Format(TimeSerial(0, 0, taskDuration * 60), "hh:mm:ss") & _
                                           Format(ms, ".000") ' Duration formatted
            .Range("F" & taskRow).Value = selectedOrg
            .Range("G" & taskRow).Value = selectedTask
            .Range("H" & taskRow).Value = funcRemark
        End With
        
        currentTime = DateAdd("s", (Rnd * 3), potentialEndTime) ' Add delay of 1 to 3 seconds before next start
        totalDuration = totalDuration + taskDuration
        taskRow = taskRow + 1
        
ContinueLoop:
    Loop
    
    With wsTracker
        .Columns("A:H").AutoFit
        .Columns("A").NumberFormat = "m/d/yyyy"
        .Columns("B").NumberFormat = "m/d/yyyy"
        .Columns("C").NumberFormat = "m/d/yyyy h:mm:ss.000 AM/PM"
        .Columns("D").NumberFormat = "m/d/yyyy h:mm:ss.000 AM/PM"
    End With
    
    MsgBox "Tasks generated successfully in the 'Task Tracker' sheet.", vbInformation
End Sub

' Function to get Org Codes from a column starting from a specific row
Function GetOrgCodes(ws As Worksheet, col As Integer, startRow As Integer) As Collection
    Dim orgCodes As New Collection
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, col).End(xlUp).Row
    Dim i As Long
    For i = startRow To lastRow
        If Trim(ws.Cells(i, col).Value) <> "" Then
            orgCodes.Add ws.Cells(i, col).Value
        End If
    Next i
    Set GetOrgCodes = orgCodes
End Function

' Function to get Functions from a column starting from a specific row
Function GetFunctionsList(ws As Worksheet, col As Integer, startRow As Integer) As Collection
    Dim funcList As New Collection
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, col).End(xlUp).Row
    Dim i As Long
    For i = startRow To lastRow
        If Trim(ws.Cells(i, col).Value) <> "" Then
            funcList.Add ws.Cells(i, col).Value
        End If
    Next i
    Set GetFunctionsList = funcList
End Function

' Function to get Remarks from a column starting from a specific row
Function GetRemarksList(ws As Worksheet, col As Integer, startRow As Integer) As Collection
    Dim remarksList As New Collection
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, col).End(xlUp).Row
    Dim i As Long
    For i = startRow To lastRow
        If Trim(ws.Cells(i, col).Value) <> "" Then
            remarksList.Add ws.Cells(i, col).Value
        End If
    Next i
    Set GetRemarksList = remarksList
End Function

' Function to perform weighted random selection
' probabilities array contains weights
' numTasks is the number of tasks
Function GetWeightedRandomTaskIndex(probabilities As Variant, numTasks As Integer) As Integer
    Dim totalWeight As Double
    Dim i As Integer
    totalWeight = 0
    For i = LBound(probabilities) To UBound(probabilities)
        totalWeight = totalWeight + probabilities(i)
    Next i
    
    Dim randVal As Double
    randVal = Rnd * totalWeight
    
    Dim cumulativeWeight As Double
    cumulativeWeight = 0
    For i = LBound(probabilities) To UBound(probabilities)
        cumulativeWeight = cumulativeWeight + probabilities(i)
        If randVal <= cumulativeWeight Then
            GetWeightedRandomTaskIndex = i
            Exit Function
        End If
    Next i
    
    ' In case of rounding errors
    GetWeightedRandomTaskIndex = UBound(probabilities)
End Function

' Function to get Remark for a given Function
Function GetRemarkForFunction(ws As Worksheet, funcCol As Integer, remarkCol As Integer, functionName As String) As String
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, funcCol).End(xlUp).Row
    Dim i As Long
    For i = 10 To lastRow ' Starting from row 10
        If Trim(ws.Cells(i, funcCol).Value) = Trim(functionName) Then
            GetRemarkForFunction = ws.Cells(i, remarkCol).Value
            Exit Function
        End If
    Next i
    ' If not found, return empty string
    GetRemarkForFunction = ""
End Function



analyze this code make the format for duration times to be displayed like this 12:01:14 AM