Sub AccumTime4()
Dim n, rw, rw1, LastRow As Long
LastRow = Cells(Rows.Count, "D").End(xlUp).Row [COLOR=#008000]'Finds the last row in the 'Date' column D[/COLOR]
Cells(2, "E") = Cells(2, "C") [COLOR=#008000] 'Copies the first minutes for the first Date to column E
[/COLOR]
[COLOR=#008000][B]'This FOR/NEXT loop checks for a change in the Date[/B] and copies the first minutes for each new Date to to column E
'It compares in column D, the previous cell value in row 'rw-1' value to the current cell value in row 'rw'[/COLOR]
For rw = 3 To LastRow
If Cells(rw - 1, "D") <> Cells(rw, "D") Then Cells(rw, "E") = Cells(rw, "C")
Next
'***********************
[COLOR=#008000]'This next part looks for blanks in column E left by the above FOR/NEXT loop
'n' keeps track of the number of rows since the last non-blank cell in column E, or the number of rows back to the first entry for that date
'ET' is the 'End Time' variable that changes value when the criteria is met in the 'IF' statements below for each Date
[/COLOR]
n = 1 [COLOR=#008000]'Sets the initial count to 1[/COLOR]
ET = Cells(2, "B") [COLOR=#008000]'This sets ET to the value of the first End Time which is in row 2[/COLOR]
For rw1 = 3 To LastRow [COLOR=#008000]'Looks at every row between row 3 and the last filled row[/COLOR]
If Cells(rw1, "E") <> "" Then [COLOR=#008000]'if the column E cell value is not blank[/COLOR]
n = 1
ET = Cells(rw1, "B") [B][COLOR=#008000]'ReSets the End Time when column E value is not blank, new date[/COLOR][/B]
GoTo Nextrw
End If
[COLOR=#008000]'When column E values are blank then the IF statements check for 3 things: [B]NO Additional time, All Additional time, and Overlapping time[/B][/COLOR]
If Cells(rw1, "E") = "" Then [COLOR=#008000]' if the column E cell value is blank
[/COLOR]
[COLOR=#008000][B]'This IF checks whether there was NO Additional time[/B], 'rw1-n' is the first row for any new date, as rw1 increases, the number of rows back 'n' to the first row for the day must increase as well
[/COLOR]
If Cells(rw1, "A") >= Cells(rw1 - n, "A") And Cells(rw1, "B") <= ET Then [COLOR=#008000]'If true then[/COLOR]
If Cells(rw1 - n, "B") > ET Then ET = Cells(rw1 - n, "B") [COLOR=#008000]'This line adjusts the value of ET if the previous cells value is greater than before[/COLOR]
n = n + 1 [COLOR=#008000]'This line increments the number of rows since the last new Date[/COLOR]
GoTo Nextrw [COLOR=#008000]'Skips the next 2 IF statements since this IF was true[/COLOR]
End If
[B][COLOR=#008000]'This IF checks whether All the Time for a new task occurs after the Original Task Ends[/COLOR][/B]
If Cells(rw1, "A") >= ET Then [COLOR=#008000]'If true then[/COLOR]
Cells(rw1 - n, "E") = Cells(rw1 - n, "E") + Cells(rw1, "C") [COLOR=#008000]'Adds All the minutes in column C to the Date total minutes[/COLOR]
ET = Cells(rw1, "B") [COLOR=#008000]'Updates the End Time variable to the new End Time[/COLOR]
n = n + 1 [COLOR=#008000]'This line increments the number of rows since the last new Date[/COLOR]
GoTo Nextrw [COLOR=#008000]'Skips the next IF statement since this IF was true[/COLOR]
End If
[B][COLOR=#008000]'This IF checks for Overlapping Durations[/COLOR][/B]
If Cells(rw1, "A") >= Cells(rw1 - n, "A") And Cells(rw1, "B") > ET Then
Cells(rw1 - n, "E") = Cells(rw1 - n, "E") + (Cells(rw1, "B") - ET) * 1440 [COLOR=#008000]'adds the extended minutes to the accumulated time[/COLOR]
ET = Cells(rw1, "B") [COLOR=#008000]'Updates the End Time variable to the new End Time[/COLOR]
n = n + 1 [COLOR=#008000]'This line increments the number of rows since the last new Date[/COLOR]
End If
End If
Nextrw: [COLOR=#008000]'This is where each of the above IF statements go to after they have run[/COLOR]
Next [COLOR=#008000]'This takes you back up to the FOR which increments rw1 which takes you to the next row down[/COLOR]
End Sub [COLOR=#008000]'This is where the macro terminates after all the rows have been checked according to the 3 criteria (IF statements).[/COLOR]
