hh:mm:ss.ms subtraction and addition

[crazycat503]

I am having the hardest time trying subtract times in this format:

hh2:mm2:ss2.ms2-hh1:mm1:ss1.ms1

The function I am using is this, which I get from somewhere but forgot (it was long time ag0). Recently, I noticed that it was giving wrong results. I tried tweaking it but no success. If someone could tweak it or may be give me another function, that would be really helpful thanks!

ption Explicit
Const MSecInSec As Double = 1000
Const SecsInMin As Double = 60
Const MinsInHour As Double = 60
Const HoursInDay As Double = 24
Const SecsInDay As Double = HoursInDay * MinsInHour * SecsInMin
Const mSecMult As Double = 1 / (SecsInDay * MSecInSec)

Public Function ReturnTimeDifference(ByVal smalltime As String, ByVal bigtime As String) As String
'On Error GoTo lblerr

Dim TimeA As Date
Dim TimeB As Date
 Dim Res As Double
 Dim timeparts As Variant
 Dim timepartsb As Variant
 Dim ms As String
 Dim ms2 As String
 Dim k As Variant
Dim r As String
Dim s As String
 timeparts = Split(smalltime, ":")
 timepartsb = Split(bigtime, ":")
 ms = timeparts(3)
 ms2 = timepartsb(3)
 
ms = ms & String(2 - Len(ms), "0")
ms2 = ms2 & String(2 - Len(ms2), "0")
 


 
 TimeA = TimeSerialEx(timeparts(0), timeparts(1), timeparts(2), ms) '01:04:12.2
 TimeB = TimeSerialEx(timepartsb(0), timepartsb(1), timepartsb(2), ms2) '05:08:15.55
 Res = Format$((TimeB - TimeA) * SecsInDay, "0.0")
'ReturnTimeDifference = Replace(Format$(Res / SecsInDay, "hh:nn:ss:") & _
 Round(Res - Fix(Res), 1) * 100, "-", "") 'avoids the decimal point and replaces any - with empty string.
s = Replace(Format$(Res / SecsInDay, "hh:nn:ss:") & _
 Round(Res - Fix(Res), 1) * 100, "-", "") 'avoids the decimal point and replaces any - with empty string.

k = Split(s, ":") 'avoids the decimal point
 r = k(0) & ":" & k(1) & ":" & k(2)

 If k(3) < 10 Then
 r = r & ":0" & k(3)
 Else
 r = r & ":" & k(3)
 End If




ReturnTimeDifference = r

End Function

Public Function TimeSerialEx(ByVal inHour As Integer, ByVal inMinute As Integer, ByVal inSecond As Integer, Optional ByVal inMillisecond As Integer = 0) As Date
 TimeSerialEx = TimeSerial(inHour, inMinute, inSecond) + (inMillisecond * mSecMult)
End Function

Public Function SecondsToHHMMSS(ByVal secs As Double)
SecondsToHHMMSS = Format(TimeSerial(0, 0, secs), "h:nn:ss")

End Function


'call it now
ReturnTimeDifference("10:20:27:87","10:00:30:98")
'result: wrong calculation.

The error is basically related with the ms part which is really driving me crazy.

[DataMiser]

I think I would take a totally different approach. Without giving it much thought what comes to mind is separating the ms portion from the time portion and compare those then if need adjust one of the remaining times up or down by one second using dateadd() then use datediff() to get the difference and append the milliseconds that would come from the first part of the comparrision.

Would take a few minutes to work out the logic but seems that it should be pretty simple and require only a few lines of code.

[crazycat503]

Hi,

Thanks for your reply. I went through your advice and tried it but couldn't get it right. Could you do me a sample code?

[moa]

Hello (I have not been here for a long time !) .

I suggest you use a structure ===>> example ===>>

Private Type my_times
  hours As String
  minutes As String
  seconds As String
  milliseconds As String
End Type


Private Sub Commandbutton1_Click()
  Dim time1 As String, time2 As String, milliseconds As Long, my_res As my_times
  time1 = "13:11:25:400"
  time2 = "12:11:26:500"
  milliseconds = to_milliseconds(time1) - to_milliseconds(time2)
  MsgBox from_milliseconds(milliseconds).hours & ":" & from_milliseconds(milliseconds).minutes & ":" & from_milliseconds(milliseconds).seconds & ":" & from_milliseconds(milliseconds).milliseconds
End Sub
Public Function to_milliseconds(what As String) As Long
   toto = Split(what, ":")
   to_milliseconds = (toto(0) * 3600000) + (toto(1) * 60000) + (toto(2) * 1000) + toto(3)
End Function
Private Function from_milliseconds(what As Long) As my_times
  from_milliseconds.hours = Format(what \ 3600000, "00")
  what = what Mod 360000
  from_milliseconds.minutes = Format(what \ 60000, "00")
  what = what Mod 6000
  from_milliseconds.seconds = Format(what \ 1000, "00")
  from_milliseconds.milliseconds = Format(what Mod 1000, "000")
End Function

Should always be right.

[moa]

An other way would be the following one,
But only if
- the two strings are in the format "##:##:##:####"
- time1 is "smaller" than time2

Dim time1 As String, time2 As String
  Dim normaltimediff As Integer, millidiff As Integer
  time1 = "15:08:26:400"
  time2 = "14:11:24:500"
  normaltimediff = DateDiff("s", CDate(Left(time2, 8)), CDate(Left(time1, 8)))
  millidiff = Val(Right(time1, 3)) - Val(Right(time2, 3))
  If millidiff < 0 Then
    millidiff = 1000 - Abs(millidiff)
    normaltimediff = normaltimediff - 1
  End If
  MsgBox CStr(TimeSerial(0, 0, normaltimediff)) & ":" & millidiff

Altough this way would look shorter and easier, I from far prefer my first code for many reasons.

[dglienna]

Do the opposite calcs:

Option Explicit
' Add a Timer control to your project.  It will be Timer1
' It looks like a stop watch in the IDE.
Dim OldTime As Date
Dim newTime As Date
Dim diff As Long
Private Sub Form_Load()
  OldTime = DateAdd("s", 360, Time) ' Add 360 seconds
  Timer1.Interval = 500
  Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
  newTime = Time
  diff = DateDiff("s", newTime, OldTime)
  Form1.Caption = (diff \ 3600) & ":" & Format((diff \ 60 Mod 60), "00") & ":" & _
        Format((diff - ((diff \ 60) * 60)), "00")
  If diff = 0 Then
    Timer1.Enabled = False
    ' You time is UP!  Do something!
    Beep
  End If
End Sub