Excel VBA Function : Calculate seconds(also counts

Question

This is the follow up post of this question and this question

I have created the following VBA function to calculate the seconds(also count the milliseconds) from two datetime.

Function:

Public Function ConvertDate(D1 As String, D2 As String) As Date
 Dim StrD1 As Date
 Dim StrD2 As Date
  StrD1 = CDate(Left(D1, 10) & " " & Replace(Mid(D1, 12, 8), ".", ":"))
  StrD2 = CDate(Left(D2, 10) & " " & Replace(Mid(D2, 12, 8), ".", ":"))
  ConvertDate = DateDiff("s", StrD2, StrD1)
End Function

Scenario 1:

Given Dates:

 2011-05-13-04.36.14.366004
 2011-05-13-04.36.14.366005

Getting Result:

0

Expected Result:

0.000001

Scenario 2:

Given Dates:

 2011-05-13-04.36.14.366004
 2011-05-13-04.36.15.366005

Getting Result:

1

Expected Result:

1.000001

Scenario 3:

Given Dates:

 2011-05-13-04.36.14.366004
 2011-05-13-04.37.14.366005

Getting Result:

60

Expected Result:

60.000001

Answer 1

A day is 1. A date is 1 for every day past 31-Dec-1899. Today happens to be 42,556. Time is a decimal portion os a day. Today at noon will be 42,556.5 and today at 06:00 pm will be 42,556.75.

There are 24 hours in a day, 60 minutes in an hour and 60 seconds in a minute. That means that there are 86,400 seconds in a day (24 × 60 × 60) and a second is ¹⁄₈₆₄₀₀ (0.0000115740740740741) of a day. Excel's 15 digit floating point calculation sometimes fouls up (loses small amounts) time calculations due to the base-24 and base-60 numbering system.

Dim tm1 As String, tm2 As String
Dim dbl1 As Double, dbl2 As Double
Dim i As Long

With Worksheets("Sheet9")
    For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row Step 2
        tm1 = .Cells(i, "A").Text
        tm2 = .Cells(i + 1, "A").Text

        dbl1 = CLng(CDate(Left(tm1, 10))) + _
               TimeValue(Replace(Mid(tm1, 12, 8), Chr(46), Chr(58))) + _
              (CDbl(Mid(tm1, 20)) / 86400)
        dbl2 = CLng(CDate(Left(tm2, 10))) + _
               TimeValue(Replace(Mid(tm2, 12, 8), Chr(46), Chr(58))) + _
              (CDbl(Mid(tm2, 20)) / 86400)
        .Cells(i + 1, "B") = (dbl2 - dbl1) * 86400
        .Cells(i + 1, "B").NumberFormat = "0.000000"
    Next i

End With

The above takes your time-and-date-as-text and calculates a pseudo-DateDiff to an accuracy of a millionth of a second. The results are displayed in seconds as an integer with fractions of a second as a decimal.