VBA code behind Schedule Style Report

[socomfort]

Hello:

I am grateful to all of you who have helped me with my questions in the past. I am now trying to create a schedule type report that shows how long a job will be in a furnace for a particular process. The report looks like a horizontal bar chart.

Before I post the code, here are the problems I am having:

1. I am trying to consolidate all of the jobs in one furnace by listing them in a recordset and populating a text box. Currently, I have a bar for each job listed by furnace number. In reality it should have one bar with all of the jobs in that furnace listed and for the process in that furnace.

2. These jobs can and do last longer than twelve hours. Many will cross midnight. I do have a public function that calculates the correct end date and end time. However, I am not sure how to make my report reflect the new day and the continuation of the job that crossed midnight.

3. I have a timeline that begins with a static start time and end time. I am not sure how to link the timeline to the start and end times of the jobs. I know that I have to find the min start time and max end time in each furnace to determine the start and end of all the jobs, but I am not sure where to go next.

What follows is the code in the report events:

Option Compare Database
Option Explicit

'*******************************************************
'*******************************************************
Private mdatEarliest As Date
Private mdatLatest As Date
Private mintDayDiff As Double 'Integer

Private Sub Report_Open(Cancel As Integer)

Dim db As Database
Dim rs As Recordset
  
  Set db = CurrentDb
  Set rs = db.OpenRecordset("SELECT Min([StartTime]) AS MinOfStartTime " _
                & " FROM qryRptHTTimeLines", dbOpenSnapshot)
  
  If rs.RecordCount > 0 Then
    mdatEarliest = rs!MinOfStartTime
  End If
  
  Set rs = db.OpenRecordset("SELECT Max(IIf(IsDate([End_Time]),CDate([End_Time]),Null)) " _
                & "AS MaxOfEndTime FROM qryRptHTTimeLines", dbOpenSnapshot)
  
  If rs.RecordCount > 0 Then
    mdatLatest = rs!MaxOfEndTime
  End If
      
  mintDayDiff = DateDiff("h", mdatEarliest, mdatLatest)
 
  Me.txtMinStartDate.Caption = Format(#12:00:00 AM#)
  Me.txtMaxEndDate.Caption = Format(#11:59:59 PM#)
  Set rs = Nothing
  Set db = Nothing

End Sub


'*******************************************************
'*******************************************************
'Revised code to account for time diffs
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
Dim db1, db2 As DAO.Database, rs1, rs2 As DAO.Recordset, sql As String
Dim intStartTimeDiff As Double, intTimeDiff As Double  ' both formerly Integer
Dim sngFactor As Single
    
  On Error Resume Next

  Me.ScaleMode = 1 'Twips
  sngFactor = Me.boxMaxTime.Width / mintDayDiff
  
  If Not IsNull(Me.StartTime) And Not IsNull(Me.End_Time) Then
    Me.boxGrowForTime.Visible = True
    Me.lblTotalHours.Visible = True
    intStartTimeDiff = Abs(DateDiff("h", Me.StartTime, mdatEarliest))
    intTimeDiff = Abs(DateDiff("h", Me.End_Time, Me.StartTime))
    
    If intStartTimeDiff = 0 Then intStartTimeDiff = 1
    With Me.boxGrowForTime
      .Left = Me.boxMaxTime.Left + (intStartTimeDiff * sngFactor)
      .Width = intTimeDiff * sngFactor
    End With

Set db1 = CurrentDb

sql = "SELECT tblHTSchedule.HeatTreatType, tblHTSchedule.FurnaceNo "
sql = sql & "FROM tblHTSchedule WHERE tblHTSchedule.HTTransactID = " & Me.HTTransactID & " AND tblHTSchedule.FurnaceNo = " & Me.FurnaceNo

Set rs1 = db1.OpenRecordset(sql, dbOpenDynaset, dbSeeChanges)
    Me.lblTotalHours.Left = Me.boxGrowForTime.Left
    Me.lblTotalHours.Caption = intTimeDiff & " Hour(s)" & vbCrLf & "Process: " & rs1.Fields("HeatTreatType")
    
Set db2 = CurrentDb
sql = "SELECT tblHTSchedule.WOID, tblHTSchedule.NumofHeats, tblHTSchedule.NumofHT "
sql = sql & "FROM tblHTSchedule WHERE tblHTSchedule.HTTransactID = " & Me.HTTransactID & " AND tblHTSchedule.FurnaceNo = " & Me.FurnaceNo
   
Set rs2 = db2.OpenRecordset(sql, dbOpenDynaset, dbSeeChanges)
    Me.lblTotalHours.Caption = Me.lblTotalHours.Caption & vbCrLf & "Job No.: " & rs2.Fields("WOID") & "-" & rs2.Fields("NumofHeats") & "-" & rs2.Fields("NumofHT")
    
  Else '
    Me.boxGrowForTime.Visible = False
    Me.lblTotalHours.Visible = False
  End If

End Sub

I used a template someone on this forum suggested I read. It proved to be helpful, however, this algorithm is proving to be quite complex and I am not sure how to proceed.

I thank you all in advance of your willing and patient help.

-Ben