Найти максимальное пересечение дат - VB

Формулировка задачи:

Очень нужна помощь. Недавно начал использовать vb. Поэтому буду рад любой помощи. Нужно составить алгоритм, определяющий наибольшее количество пересечении во времени. Первый вектор это время начала. Второй - продолжительность в секундах. По Моим условиям оно равняется 3. То есть 3 первые события происходят в одно время.

Dim d1(1 To N) As Date, d2(1 To N) As Integer, d3(1 To N) As Date 
N = 6 
d1(1) = #5/1/2016 8:30:11 PM# 'время начала интервью 
d1(2) = #5/1/2016 8:32:30 PM# 
d1(3) = #5/1/2016 8:32:42 PM# 
d1(4) = #5/1/2016 8:46:41 PM# 
d1(5) = #5/1/2016 8:51:06 PM# 
d1(6) = #5/1/2016 9:36:33 PM# 
 
d2(1) = 200 'длительность интервью 
d2(2) = 20 'задается в секундах 
d2(3) = 314 
d2(4) = 1000 
d2(5) = 1142 
d2(6) = 1000

Решение задачи: «Найти максимальное пересечение дат»

textual
                            Листинг программы 
                        

                            Option Explicit
 
Private Sub Command1_Click()
Const N = 6
Dim d1(1 To N) As Date, d2(1 To N) As Integer
Dim countDub As Integer, i As Integer, j As Integer
countDub = 0
 
d1(1) = #5/1/2016 8:30:11 PM# 'время начала интервью
d1(2) = #5/1/2016 8:32:30 PM#
d1(3) = #5/1/2016 8:32:42 PM#
d1(4) = #5/1/2016 8:46:41 PM#
d1(5) = #5/1/2016 8:51:06 PM#
d1(6) = #5/1/2016 9:36:33 PM#
 
d2(1) = 200 'длительность интервью
d2(2) = 20 'задается в секундах
d2(3) = 314
d2(4) = 1000
d2(5) = 1142
d2(6) = 1000
 
 
For i = 1 To 6
    For j = 1 To 6
        If CDbl(d1(i)) < CDbl(d1(j)) And CDbl(d1(j)) < CDbl(DateAdd("s", d2(i), d1(i))) Then
        countDub = countDub + 1
           Print "Совпадает : " & d1(i) & " и " & d1(j)
        End If
    Next
 Next
 
MsgBox "Всего пересечений = " & countDub
 
 
End Sub
                        