round duration of time to quarters

[Afarag]

Hi,

i need you support in handling this issue for distribute a duration of time to quarters, as i have a phone calls duration for IDs, this calls need to distribute its duration to intervals, eg: if a call duration is 0:21:0 from 10:05 AM till 10:26 Am, so this call is located in 2 interval once in 10:00 and 10:15.

i have 2 tables: 1st for IDs, call time and call duration, the 2nd for IDs, all time quarters for IDs.

want in the 2nd table for the above eg: the matched ID interval 10:00 lookup duration 0:15:00 and the rest of duration 0:06:0 will fill beside quarter 10:15

i'm used this code and sounds like something in round calculation as some large duration isn't distribute to interval

Sub CreateIntervals()

With Sheets("CallAccountReport")
  .Columns("H:H").NumberFormat = "mm:ss"
  LastRow = .Range("A" & Rows.Count).End(xlUp).Row
  newIntervalRow = 2

  Dim TimeOfCall As Date
  Dim Interval As Double
  Dim EndInterval As Date
  Dim Duration As Double

  Dim CurrentTimeInterval As Date
  For RowCount = 2 To LastRow
      LoginID = .Range("A" & RowCount)
      TimeOfCall = .Range("B" & RowCount) - Int(.Range("B" & RowCount))
      Interval = .Range("C" & RowCount)
      Duration = .Range("D" & RowCount)
 
      Do While (Duration > 0)
        EndInterval = Interval + TimeSerial(0, 15, 0)

        CurrentTimeInterval = EndInterval - TimeOfCall
        If CurrentTimeInterval > Duration Then
          CurrentTimeInterval = Duration
        End If
   
        .Range("F" & newIntervalRow) = LoginID
        .Range("G" & newIntervalRow) = Interval
        .Range("H" & newIntervalRow) = CurrentTimeInterval - Int(CurrentTimeInterval)
     
        Interval = EndInterval
        Duration = Duration - CurrentTimeInterval
 
        newIntervalRow = newIntervalRow + 1
      Loop
 

  Next RowCount

End With

End Sub

Gratefully,