Macro to calculate the difference in hh:mm:ss - vba

I want to calculate the difference in hh:mm:ss between Now and column E. They both appear in format dd/mm/yyyy hh:mm. With the code I have written below, it only takes into consideration the hh:mm and not the days. So, if they have 2 days difference in wont add to the hours +48. The code is below:
With ws1.Range("N2:N" & lastrow1)
.Formula = "=TIME(HOUR(NOW()),MINUTE(NOW()),SECOND(NOW()))-TIME(HOUR(E2),MINUTE(E2),SECOND(32))"
End With

Just use =(NOW()-E2) and apply a custom format [hh]:mm:ss. The brackets around hh will do the trick.
If you rather need a number of hours, multiply by 24 as #Kerry Jackson suggested.
The logic behing date/time values is that 1 day = 1, so
1 hour = 1/24
1 min = 1/1440 '(that is 24*60 )
etc...

Put this in a module
Public Function DateTimeDiff(d1 As Date, d2 As Date)
Dim diff As Double
diff = ABS(d2 - d1)
DateTimeDiff = Fix(diff) & Format(diff, " hh:mm")
End Function
Then use
=DateTimeDiff( NOW(), E2 )
as the formula in the worksheet.
You might want to add some validation on the dates and return an error message if they are not valid.

Are you looking for a number which is the number of hours, or are you looking for text?
If you want the number of hours, try just subtracting the dates, and multiplying by 24, so the formula would be =(NOW()-E2)*24.

Public Function timeElapsed(ByVal target_cell As Range) As String
Dim hours As Long, minutes As Long, days As Long
If target_cell.Value = 0 Then Exit Function
x = DateDiff("n", target_cell, Now())
days = Format(Application.WorksheetFunction.RoundDown(x / 1440, 0), "00")
hours = Format(Application.WorksheetFunction.RoundDown((x - (days * 1440)) / 60, 0), "00")
minutes = Format(Application.WorksheetFunction.RoundDown((x - ((days * 1440) + (hours * 60))), 0), "00")
timeElapsed = CStr(days) & " " & "days" & " " & CStr(hours) & ":" & CStr(minutes)
End Function
And use as function with the result as below:
So you code becomes:
With ws1
.Range("N2:N" & lastrow1).FormulaR1C1 = "=timeElapsed(RC[-9])"
End With

Related

Double to Time Format VBA

At the begging I want tell you that I just read a lot of stack's about it and I didnt find solution so...
I'm substracting two dates
1 - 2017/05/05 17:00
2 - 2017/05/09 18:00
I want to receive "4 Days 1 Hour"
How I should do it? I tried to use DateFormat/Format/DateDiff and a lot of things.
It doesn't always have to be a ready-made VBA function. Especially with dates, I rarely find what I want exactly as VBA-ready. Try this custom function:
Function myDateDiff(ByVal d1 As Date, ByVal d2 As Date) As String
Dim days As Long, hours As Long
days = DateDiff("d", d1, d2) ' diff in days
hours = DateDiff("h", d1, d2) - days * 24 ' diff in hours
myDateDiff = days & " Day" & IIf(days > 1, "s ", " ") & hours & " Hour" & IIf(hours > 1, "s", "")
End Function
Sub Test()
Dim d1 As Date, d2 As Date
d1 = CDate("2017/05/05 17:00")
d2 = CDate("2017/05/09 18:00")
Debug.Print myDateDiff(d1, d2) ' 4 Days 1 Hour
d1 = CDate("2017/05/05 17:00")
d2 = CDate("2017/05/06 19:00")
Debug.Print myDateDiff(d1, d2) ' 1 Day 2 Hours
End Sub

Convert 24 hour Clock to 12 hour clock and add 6 hours

I have infinite rows with with a single column assigned to define date and time in the following 'General Format' "2016.08.10 06:00:00.066". I am aware that you can't convert every single cell in this column "mm/dd/yyyy hh:mm:ss.000 AM/PM". Therefore I would a single column assigned to "mm/dd/yyyy" and another column assigned to "hh:mm:ss.000 AM/PM". The time is currently 6 hours behind as well so I would like to add 6 hours to it.
I am struggling with this as although the cells are in general or text format the time and date is being displayed as "yyyy.mm.dd hh:mm:ss.000". And can't find a way to split the two in this format
Any help is appreciated
To convert the text to a format that Excel will change to a data/time use this:
=--SUBSTITUTE(SUBSTITUTE(A1,".","/",1),".","/",1)
Then to add 6 hours you would use:
+ TIME(6,0,0)
So to get the date/time is:
=--SUBSTITUTE(SUBSTITUTE(A1,".","/",1),".","/",1) + TIME(6,0,0)
Then simply format the new cell:
mm/dd/yyyy hh:mm:ss.000 AM/PM
You can also split it into the date and time:
Date:
=INT(--SUBSTITUTE(SUBSTITUTE(A1,".","/",1),".","/",1) + TIME(6,0,0))
And format it mm/dd/yyyy
Time:
=MOD(--SUBSTITUTE(SUBSTITUTE(A1,".","/",1),".","/",1) + TIME(6,0,0)),1)
And format it hh:mm:ss.000 AM/PM
use text: =concatenate(text(a1,"MM"),text(a1,"DD"),text(a1,"YYYY") do the same for the other column =concatenate(text(a1,"HH"),text(a1,"MM"),text(a1,"SS")
That's pretty strange that you Excel will round off the milliseconds if you try and use a Date-Time format.
Enum DTValues
ReturnDate
ReturnTime
ReturnDateTime
End Enum
Function getDateTime(yyyymmdd_hh_mm_ss_000 As String, ReturnValue As DTValues) As Single
Dim arr
Dim mSecs As Single
yyyymmdd_hh_mm_ss_000 = Replace(yyyymmdd_hh_mm_ss_000, " ", ".")
yyyymmdd_hh_mm_ss_000 = Replace(yyyymmdd_hh_mm_ss_000, ":", ".")
arr = Split(yyyymmdd_hh_mm_ss_000, ".")
mSecs = arr(6) / 24 / 60 / 60 / 100
Select Case ReturnValue
Case ReturnDate
getDateTime = CSng(DateSerial(arr(0), arr(1), arr(2)))
Case ReturnTime
getDateTime = CSng(TimeSerial(arr(3), arr(4), arr(5))) + mSecs
Case ReturnDateTime
getDateTime = CSng(DateSerial(arr(0), arr(1), arr(2))) + CSng(TimeSerial(arr(3), arr(4), arr(5))) + mSecs
End Select
End Function
Sub ProcessDates()
Const WORKSHEET_NAME = "Sheet1"
Const FIRST_ROW = 2
Const SOURE_COLUMN = 1
Const DATE_COLUMN = 2
Const TIME_COLUMN = 3
Dim Target As Range
Dim arDate, arTime
Dim y As Long
With Worksheets(WORKSHEET_NAME)
Set Target = .Range(.Cells(FIRST_ROW, SOURE_COLUMN), .Cells(Rows.Count, SOURE_COLUMN).End(xlUp))
End With
arDate = Target.Value
arTime = Target.Value
For y = 1 To UBound(arDate)
arDate(y) = getDateTime(arDate(y), ReturnDate)
arTime(y) = getDateTime(arTime(y), ReturnTime)
Next
Target.EntireRow.Columns(DATE_COLUMN).Value = arDate
Target.EntireRow.Columns(TIME_COLUMN).Value = arTime
End Sub

Excel VBA Function : Calculate seconds(also counts the milliseconds) from two dates

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
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.

How can I account for the midnight time change in this code?

I need to define the shift length for 3 different types of shifts: an 8, 10, or 12 hour shift.
8 hour shift:
1st shift: 6am-2pm
2nd shift: 2pm-10pm
3rd shift: 10pm-6am
10 hour shift:
1st shift: 5am-3pm
2nd shift: 3pm-1am
12 hour shift:
1st shift: 3am-3pm
2nd shift: 3pm-3am
The problem is that I'm not sure what is the best way to deal with the midnight changeover. When you do Datediff("n", #10:00:00:pm#, #06:00:00#), it gives a negative value because it thinks you want the time difference from 6am going to 10pm (but with a negative value). This is not what I want.
My code below keeps giving me negative values for the times where it changes over the midnight line.
The extremely tricky part here is that users can submit a start_time of, let's say, 2:30:00 AM, which is past the midnight line. This further complicates things.
How can I make it so that not only does my code return the correct shift length, but also accounts for the possibility of users submitting start times after midnight?
(Switch
(Max([dbo_job.Uf_Shift_Standard])="8",
(Switch(
(tbl_OEE.shift = "SH1"),
Datediff("n", Max([start_time]), [end_time]),
(tbl_OEE.shift = "SH2"),
Datediff("n", Max([start_time]), [end_time]),
True,
Datediff("n", Max([start_time]), #23:59:59#) + Datediff("n", #00:00:00#, #06:00:00#))),
Max([dbo_job.Uf_Shift_Standard])="10",
(Switch(
(tbl_OEE.shift = "SH1"),
Datediff("n", Max([start_time]), [end_time]),
True,
Datediff("n", Max([start_time]), #23:59:59#) + Datediff("n", #00:00:00#, #01:00:00#))),
Max([dbo_job.Uf_Shift_Standard])="12",
(Switch(
(tbl_OEE.shift = "SH1"),
Datediff("n", Max([start_time]), #15:00:00#),
True,
Datediff("n", Max([start_time]), #23:59:59#) + Datediff("n", #00:00:00#, #03:00:00#)))
)
) AS actual_shift_length_minutes
You can add 1 (= one day) to the time difference, then calculate it directly using TimeValue to remove the date part:
ShiftDuration = TimeValue(CDate(#06:00:00 am# - #10:00:00 pm# + 1))
ShiftDuration = TimeValue(CDate(#10:00:00 pm# - #02:00:00 pm# + 1))
ShiftDuration = TimeValue(CDate(#02:00:00 pm# - #06:00:00 am# + 1))
All of these will return a date/time value (a timespan) of 08:00:00 which can format for display using Format as you like or convert to hours and/or minutes.
If you need to display durations of more than 24 hours, use a function like this:
Public Function FormatHourMinute( _
ByVal datTime As Date, _
Optional ByVal strSeparator As String = ":") _
As String
' Returns count of days, hours and minutes of datTime
' converted to hours and minutes as a formatted string
' with an optional choice of time separator.
'
' Example:
' datTime: #10:03# + #20:01#
' returns: 30:04
'
' 2005-02-05. Cactus Data ApS, CPH.
Dim strHour As String
Dim strMinute As String
Dim strHourMinute As String
strHour = CStr(Fix(datTime) * 24 + Hour(datTime))
' Add leading zero to minute count when needed.
strMinute = Right("0" & CStr(Minute(datTime)), 2)
strHourMinute = strHour & strSeparator & strMinute
FormatHourMinute = strHourMinute
End Function

Returning the exact date difference without using DateDiff

I need to return the exact difference between two dates in the form of a string.
If the dates are 01-FEB-2012 and 01-FEB-2014, the function should return "2 years".
If the dates are 01-FEB-2012 and 01-MAR-2014, the function should return "25 months".
If the difference is not in exact years or months, it should return the difference in days.
I do not want to use DateDiff from the Visual Basic namespace so the code is portable to C#.
'Assuming d1 < d2
Public Function GetDateDiff(d1 as DateTime, d2 As DateTime) As String
If d1.Day = d2.Day Then
Dim yearDiff As Integer = d2.Year - d1.Year
If d1.Month = d2.Month Then
'Only year differs
Return yearDiff & " years"
Else
'Month and year differs
Dim monthDiff As Integer = d2.Month - d1.Month
Return (yearDiff * 12 + monthDiff) & " months"
End If
Else
Return (d2-d1).TotalDays & " days"
End If
End Function