Excel VBA Closest Time of the Job and status in another cell

[bobbyexcel]

Could someone please help me on my below issue..


I want to mention the Final status of each job in Column G based on the below condition of the Job Status..

1. Job should run between 8PM to next Day 3PM.
2. The closest to 3PM would be the Final status of the Job
3. Final Status should apply to all Jobs in that Particular "Start Date".

I've the below code but it checks individual rows but not the the jobs with same name..
Dim lastrow As Integer
Dim timeRng As Range
Set timeRng = sws.Range("L2:L" & lastrow)

lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

TimeSer = TimeSerial(16, 30, 0) ' constant 04:30:00PM later used to create min and max datetime values

For Each Cell In timeRng

If Cell.Value < TimeSer Then
Range("G" & Cell.Row) = Range("B" & Cell.Row)
End If

Next Cell

 

[BSALV]

without the condition of that shift runs from 8PM until 3PM the next day, that can easy be done by formulas
BobbyExcel

Sub FinalStatus()
     Dim T_Start, T_Stop, Shift_Start, Shift_Stop, Result    'your 4 timestamps
     Set dict = CreateObject("scripting.dictionary")
     Set lo = Sheets("Jobs").ListObjects("TBL_Jobs")     'table with your data
     arr = lo.DataBodyRange.Value2     'read that table to an array
     ReDim Result(1 To UBound(arr), 1 To 1)

     '1st ROUND : find last status at the end of the shift
     For i = 1 To UBound(arr)     'loop through data
          T_Start = arr(i, 3) + arr(i, 4)     'timestamp end of job
          T_Stop = arr(i, 5) + arr(i, 6)     'timestamp end of job
          b = (arr(i, 4) < TimeSerial(20, 0, 0))     'moment start job is before 8PM (to know the startdate & time of that shift
          Shift_Start = CDbl(arr(i, 3) + TimeSerial(20, 0, 0) + b)     'that shift started at 8PM of this date
          Shift_Stop = CDbl(Int(Shift_Start) + 1 + TimeSerial(15, 0, 0))     ' that shift stopped at 3PM next day
          If WorksheetFunction.Median(Shift_Start, T_Start, Shift_Stop) = T_Start And WorksheetFunction.Median(Shift_Start, T_Stop, Shift_Stop) = T_Stop Then     'both times are in the good timerange
               mykey = arr(i, 1) & Format(Shift_Stop, "\|dd-mmm-yy_hh:mm")
               If Not dict.exists(mykey) Then
                    dict(mykey) = Array(T_Stop, arr(i, 2))
               Else
                    MsgBox dict(mykey)(0)
                    If dict(mykey)(0) < T_Stop Then dict(mykey) = Array(T_Stop, arr(i, 2))
               End If
          Else
               MsgBox "Listrow " & i & vbTab & arr(i, 1) & vbTab & lo.DataBodyRange(i, 1).Address & vbLf & "job ran from " & Format(T_Start, "dd-mmm hh:mm") & " until " & Format(T_Stop, "dd-mmm hh:mm") & vbLf & "Shift was from " & Format(Shift_Start, "dd-mmm hh:mm") & " until " & Format(Shift_Stop, "dd-mmm hh:mm"), vbInformation, UCase("timestamps not okay")
               Result(i, 1) = "not within the shift"
          End If
     Next

     '2nd ROUND : add status corresponding with status "end of shift"
     For i = 1 To UBound(arr)     'loop through data
          If Len(Result(i, 1)) = 0 Then     'no blocking conditions
               T_Start = arr(i, 3) + arr(i, 4)     'timestamp end of job
               T_Stop = arr(i, 5) + arr(i, 6)     'timestamp end of job
               b = (arr(i, 4) < TimeSerial(20, 0, 0))     'moment start job is before 8PM (to know the startdate & time of that shift
               Shift_Start = CDbl(arr(i, 3) + TimeSerial(20, 0, 0) + b)     'that shift started at 8PM of this date
               Shift_Stop = CDbl(Int(Shift_Start) + 1 + TimeSerial(15, 0, 0))     ' that shift stopped at 3PM next day
               mykey = arr(i, 1) & Format(Shift_Stop, "\|dd-mmm-yy_hh:mm")     'key within dictionary
               Result(i, 1) = dict(mykey)(1)     'last known status
          End If
     Next

     lo.ListColumns("Final").DataBodyRange.Value = Result     'write array to listobject

End Sub

 

[bobbyexcel]

Thanks for your support however, this isn't giving me the right results.. here is the screenshot of the result.

I'm expecting the result would be like this.. (per the below screenshot)

And the job results should be between Anytime to next Day 3 PM.. do not want the time from 8PM) . Sorry for the correction and apologize for confusion.

 

[BSALV]

BobbyExcel
now as macro and as UDF

Sub FinalStatus()
     Dim T_Start, T_Stop, Shift_Start, Shift_Stop, Result    'your 4 timestamps
     Set dict = CreateObject("scripting.dictionary")
     Set lo = Sheets("Jobs").ListObjects("TBL_Jobs")     'table with your data
     arr = lo.DataBodyRange.Value2     'read that table to an array
     ReDim Result(1 To UBound(arr), 1 To 1)

     '1st ROUND : find last status at the end of the shift
     For i = 1 To UBound(arr)     'loop through data
          T_Start = arr(i, 3) + arr(i, 4)     'timestamp end of job
          T_Stop = arr(i, 5) + arr(i, 6)     'timestamp end of job
          mykey = arr(i, 1) & Format(arr(i, 3), "\|dd-mmm-yy")     'job name & start date
          If T_Stop <= arr(i, 3) + 1 + TimeSerial(15, 0, 0) Then     'job must end before next day 3PM
               If Not dict.exists(mykey) Then
                    dict(mykey) = Array(T_Stop, arr(i, 2))
               Else
                    If dict(mykey)(0) < T_Stop Then dict(mykey) = Array(T_Stop, arr(i, 2))     '---> for that job and that startdate, the last endmoment & status
               End If
          Else
               MsgBox "Listrow " & i & vbTab & arr(i, 1) & vbTab & lo.DataBodyRange(i, 1).Address & vbLf & "job ran from " & Format(T_Start, "dd-mmm hh:mm") & " until " & Format(T_Stop, "dd-mmm hh:mm") & vbLf & "didn't stop before " & Format(arr(i, 3) + 1 + TimeSerial(15, 0, 0), "dd-mmm hh:mm")
               Result(i, 1) = "not within the shift"
          End If
     Next

     '2nd ROUND : add status corresponding with status "end of shift"
     For i = 1 To UBound(arr)     'loop through data
          If Len(Result(i, 1)) = 0 Then     'no blocking conditions
               mykey = arr(i, 1) & Format(arr(i, 3), "\|dd-mmm-yy")    'key within dictionary
               Result(i, 1) = dict(mykey)(1)     'last known status
          End If
     Next

     lo.ListColumns("Final macro").DataBodyRange.Value = Result     'write array to listobject

End Sub

Function F_FinalStatus(job, startdate)
     Dim T_Start, T_Stop, Shift_Start, Shift_Stop, Result    'your 4 timestamps
     
     F_FinalStatus = "unknown"
     
     Set lo = Sheets("Jobs").ListObjects("TBL_Jobs")     'table with your data
     If lo.ListRows.Count = 0 Then Exit Function
     arr = lo.DataBodyRange.Resize(, 6).Value2    'read that table to an array
    
     For i = 1 To UBound(arr)     'loop through data
          If arr(i, 1) = job And arr(i, 3) = CDbl(startdate) Then
               T_Stop = arr(i, 5) + arr(i, 6)     'timestamp end of job
               If T_Stop <= arr(i, 3) + 1 + TimeSerial(15, 0, 0) Then     'job must end before next day 3PM
                    If T_Stop > t_Previous Then
                         t_Previous = T_Stop
                         F_FinalStatus = arr(i, 2)
                    End If
               End If
          End If
     Next
End Function

 

[bobbyexcel]

Thanks for your updated code.. however this seems some correction.. could you please check and help me..

 

[BSALV]

row 4-5 has to be "success" !?
BobbyExcel

 

[bobbyexcel]

No.. row 4-5 has to be failed coz row 4 is between the time range but not row 5. So row 4 Status (from B4) is failed so the final status is failed for both.

 

[BSALV]

what is the time range, i misunderstood you since the beginning !!!
if a job starts in Day1 and stops before 3PM the next day, then it's a valid record.
Row4 is okay, even although the end < begin (is that possible ??)
Also row5 is okay and its endtime is nearer to 3PM of Day2 (7-apr)

 

[bobbyexcel]

Thats ok.. you are helping me allot thanks for that and let me explain again..

if a job starts in Day1 and stops before 3PM the next day, then it's a valid record.
Also row5 is okay and its endtime is nearer to 3PM of Day2 (7-apr) -- No, row5 crossed 3PM, so it is not valid.

Now we need to check the job that completed nearest to 3PM which is row 4.
Now get the status of row 4 (B4) status(6thApr XYZ job) and update to both row4 & 5 Jobs final status (G4 & G5).

Hope I explained the requirement properly !!

 

[BSALV]

sorry, I'm too confused to solve this problem