VBA Get specific differences in hours - vba

I'm having trouble in getting the detailed or specific differences between two dates in minutes. Let's say:
Date Start : 24/7/2015 12:38:00 PM
Date End : 27/7/2015 12:12:00 PM
My code did give the differences between both date but actually does not specific, which means it gives difference of 3 days between both date, but not just I want (Let's say their difference is 68hours 30minutes 56seconds). So, how can I do this?
Here is my code :
Date1 = DateValue(CurrentSheet.Cells(PRow, "U").Value)
Date2 = DateValue(CurrentSheet.Cells(PRow, "S").Value)
FRow = CurrentSheet.UsedRange.Cells(1).Row
lrow = CurrentSheet.UsedRange.Rows(CurrentSheet.UsedRange.Rows.count).Row
For PRow = lrow To 2 Step -1
CurrentSheet.Cells(PRow, "AD").Value = DateDiff("d", Date2, Date1) 'produce days
CurrentSheet.Cells(PRow, "AE").Value = DateDiff("h", Date2, Date1) 'produce hours
CurrentSheet.Cells(PRow, "AF").Value = DateDiff("n", Date2, Date1) 'produce minutes
Next PRow
Currently the answer I got :
3 days,
72hours (3 times 24hours),
1440minutes (24hours times 60minutes).

The reason is that you have used function DateValue that converts a value to date only (time part is removed).
So, those dates:
Date Start : 24/7/2015 12:38:00 PM
Date End : 27/7/2015 12:12:00 PM
after processing them with DateValue function became:
Date Start : 24/7/2015 00:00:00
Date End : 27/7/2015 00:00:00
[EDIT]
You need to convert them to Date type.
You can use VBA built-in function CDate to do that:
Date1 = CDate(CurrentSheet.Cells(PRow, "U").Value)
Date2 = CDate(CurrentSheet.Cells(PRow, "S").Value)

Internally, dates are stored as number of days since Jan-1-1900 (or 1902, in does not really matter). That means 1 day = 1, that also means 1 hour = 1/24.
So if I understand your question correctly, to get the difference in days, hours, minutes between date2 and date1, you could use
daysdiff = DateDiff("d", Date2, Date1)
hoursdiff = INT((Date2-date1-Daysdiff)/24)
'or
hoursdiff = DateDiff("h", Date2-daysdiff, Date1)
minutesdiff = Datediff("n", Date2-daysdiff-hoursdiff/24, Date1)
Sorry, not tested, but you get the idea.
Edit: you should also include #mielk remarks in you changes.

Actually, it's simple! I never thought of this way could produce the answer just like I want! :)
Dim FRow As Long
Dim lrow As Long
Dim PRow As Long
Range("AD1").Value = "Hours Differences"
Dim CurrentSheet As Worksheet
Set CurrentSheet = Excel.ActiveSheet
FRow = CurrentSheet.UsedRange.Cells(1).Row
lrow = CurrentSheet.UsedRange.Rows(CurrentSheet.UsedRange.Rows.count).Row
For PRow = lrow To 2 Step -1
CurrentSheet.Cells(PRow, "AD").Value = (CurrentSheet.Cells(PRow, "U").Value - CurrentSheet.Cells(PRow, "S").Value) * 24
Next PRow
It will produce 71.5666666666511. I was distracted by DATE format. Thanks all for those helps! :D

Related

VBA - Date Format "mm/dd/yyyy"

My excel file format for date is Mar 30 2016 10:12:27:396AM i want to change the format to mm/dd/yyyy. but i'm having an error on my code..
Run-time error '13': Type mismatch
this is the line i got the error SecondDate = Trim(Sheet2.Range("B" & RowNo).Value)
Note: The data from Column A and B are dates
My Code:
Dim Result, RowNo As Long
Dim FirstDate As Variant
Dim SecondDate As Variant
RowNo = 2
FirstDate = Trim(Sheet2.Range("A" & RowNo).Value)
SecondDate = Trim(Sheet2.Range("B" & RowNo).Value)
FirstDate = Format(FirstDate, "mm/dd/yyyy")
SecondDate = Format(SecondDate, "mm/dd/yyyy")
Do Until Sheet2.Cells(RowNo, 1) = ""
FirstDate = Sheet2.Cells(RowNo, 1)
SecondDate = Sheet2.Cells(RowNo, 2)
If DateDiff("d", FirstDate, SecondDate) >= 15 Then
Sheet2.Cells(RowNo, 3) = "1"
Sheet2.Cells(RowNo, 4) = "2"
End If
RowNo = RowNo + 1
Loop
i do feel like im in the right path..am i missing something?
Update: My script will get the data from Column A and Column B and using the DateDiff function i will subtract both columns if the difference is <15 tag it from Column C and D as 1, 2
note:
i only subtract the days from both columns.. but is it possible to subtract both days and years?
it's working if i use the format mm/dd/yyyy in the excel but if i use other format i got the error mismatch
Updated 2:
Column A | Column B | Column C
Mar 1 2016 10:12:27:396AM | Mar 30 2016 10:12:27:396AM |
Mar 1 2016 10:12:27:396AM | Mar 30 2016 10:12:27:396AM |
in my file this is the date format, if you try this as sample data it won't work maybe because VBA doesnt recognize this as dateformat?
Perhaps this will address what you are trying to do.
Test Input:
Test Output:
Code:
Sub DateStuff()
Dim FirstDate As Range, SecondDate As Range
Dim RowNo As Long
Set FirstDate = Sheet4.Range("A1")
Set SecondDate = Sheet4.Range("A2")
FirstDate.NumberFormat = "mm/dd/yyyy"
SecondDate.NumberFormat = "mm/dd/yyyy"
RowNo = 2
Do Until Sheet4.Cells(RowNo, 1) = ""
Set FirstDate = Sheet4.Cells(RowNo, 1)
Set SecondDate = Sheet4.Cells(RowNo, 2)
If IsDate(FirstDate.Value) And IsDate(SecondDate.Value) Then
If DateDiff("d", FirstDate, SecondDate) >= 15 Then
Sheet4.Cells(RowNo, 3) = 1
Sheet4.Cells(RowNo, 4) = 2
End If
End If
RowNo = RowNo + 1
Loop
End Sub
Please spend a few minutes to understand this code:
FirstDate and SecondDate are Range data types, not Date or Variant. The data in the cells they point to are Date or something else.
When setting the format, it sets how it is displayed on the worksheet. It is not formatting a character string in VBA.
Before making the DateDiff call, ensure both FirstDate and SecondDate really contain Date datatypes in the cells, this will prevent many errors.
Operations on Date datatypes using Date functions are NOT dependent on formatting. They use the internal Date type. Formatting ONLY affects how a date is converted to a string and/or displayed on the worksheets.
You asked about checking year instead of day. There are built in VBA functions (e.g. Year, Month, etc.) that will help with this.
As to your update to your question:
I am not sure where you are getting your time codes from, but Excel does not recognize :000 for milliseconds. It uses .000. See below ...

ISO week number in VBScript or VBA

How can I get the ISO week number of some date in VBScript or VBA?
First, note that:
It is important to report the week year along with the week number, as the date's year could be different.
Several Windows components contain a bug for some years' last Monday.
In my experience the simplest, clearest and most robust way to compute this is:
Sub WeekNum(someDate, isoWeekYear, isoWeekNumber, isoWeekDay)
Dim nearestThursday
isoWeekDay = WeekDay(someDate, vbMonday)
nearestThursday = DateAdd("d", 4 - Int(isoWeekDay), someDate)
isoWeekYear = Year(nearestThursday)
isoWeekNumber = Int((nearestThursday - DateSerial(isoWeekYear, 1, 1)) / 7) + 1
End Sub
This also returns the ISO day of the week, counting from 1 for Mondays.
Enter any date into A1 cell, then run following code...
Range("A2").FormulaR1C1 = "=INT((R1C-DATE(YEAR(R1C-WEEKDAY(R1C-1)+4),1,3)+WEEKDAY(DATE(YEAR(R1C-WEEKDAY(R1C-1)+4),1,3))+5)/7)"
You can get it via DatePart() VBA function:
Sub IsoWeek()
Dim isoWeekNum As Byte
Dim myDate As Date
myDate = DateValue("01-01-2022")
isoWeekNum = DatePart("ww", myDate, vbMonday, vbFirstFourDays)
If isoWeekNum > 52 Then ' Bug check (to avoid the bug with Mondays)
If Format(myDate + 7, "ww", vbMonday, vbFirstFourDays) = 2 Then isoWeekNum = 1
End If
Debug.Print isoWeekNum
End Sub

VBA: How to make an IF statement on a DateDiff function

In a VBA project i'm working on, I need to count the number of lines where the difference between two dates is inferior to X hours.
My idea was to go through all the lines and check for each line, like this:
Dim count as Integer
if DateDiff("h", date1, date2) < 24 then
count = count + 1
End If
The problem is that I get an incompatibility type error (execution error 13).
Is it possible to make IF statements on a DateDiff function? Or is it maybe possible to make a filter with DateDiff as the condition?
Thanks for the help and sorry for my poor english as it's not my main language!
I have tested it like this without any errors.
Dim date1 As Date
Dim date2 As Date
date1 = "14/10/2015 19:00:00"
date2 = "14/10/2015 16:28:43"
If DateDiff("h", date1, date2) < 24 Then
count = count + 1
End If
The VBA conversion function CDate can apply a little of the overhead you constantly pay for to correct the dates. With that said, it is best to correct the data to begin with and not rely upon error controlled conversion functions.
Dim date1 As Date, date2 As Date, n As Long
date1 = CDate("14/10/2015 19:00:00")
date2 = CDate("14/10/2015 16:28:43")
Debug.Print date1 & " to " & date2
If IsDate(date1) And IsDate(date2) Then
If DateDiff("h", date1, date2) < 24 Then
n = n + 1
End If
'alternate
If date2 - date1 < 1 Then
n = n + 1
End If
End If
Given that 24 hours is a day and a day is 1, simple subtraction should be sufficient for this base comparison.
Your DMY format may cause problems with the EN-US-centric VBA in date conversion. If an ambiguous date string is found (e.g. "11/10/2015 16:28:43") you may find that you are interpreting it as MDY.

VBA Incrementing Date Error

I've never done VBA before but a friend has asked for help so I've been working on his project. I'm trying to increment a given date by one day but I'm getting an "Object Required" error in the DateAdd function. As far as I can tell I'm putting in an object (firstDate)...
The date entered,for my testing purposes at least, has been 12/03/2012 in that format.
The Format and CDate functions seem to work fine and parse the date.
Here's the code, I get the error at the line with DateAdd in it.
Sub GetDate()
Dim strDate As String
strDate = InputBox(Prompt:="Enter the first day of the week in dd/mm/yyyy format.", _
title:="First day of the week", Default:="")
If strDate = "" Or strDate = vbNullString Then
Exit Sub
Else
Dim firstDate As Date
firstDate = CDate(Format(strDate, "Short Date"))
'Add to O and 6 after
For inc = 0 To 6 Step 1
Range(Chr(79 + inc) & 1) = firstDate
firstDate = DateAdd(DateInterval.Day, 1, firstDate)
Next
End If
End Sub
Appreciate any help.
You're just trying to increment by one day, right?
firstDate = firstDate + 1
The unit of the Date type is one day. So adding 1 adds one day.
Very well...
DateAdd("d", 1, firstDate)
But: I'm not that fussed if anyone reposts a comment of mine as an answer. I do read the comments as well as the answers. Maybe because I have this habit of suggesting answers in comments...

how to compare time in vba

I want to write a macro that compares two times that is available in cells A1 and B1
I tried to use the following code BUT it gave me "type dismatch" at date1 = TimeValue(Range("A1"))
for example, the value at cell A1 like this 11/18/2011 10:11:36 PM
dim date1 as date
dim date2 as date
date1 = TimeValue(Range("A1"))
date1 = TimeValue(Range("B1"))
if date1 > date2 then
'do something
else
'do something else
end if
you need to use Range("A1").Value
Two things:
try changing the value in A1 to 11/10/2011 10:11:36 PM If things
now work you may have a Regional Settings mismatch
you've declared date1 and date2 but are assigning twice to date1 and never
assigning to date2
use application.worksheetfunction.mod( date value, 1 )
You ought to understand that date and time in excel is represented by a serial number, in which 1 equals to a day, and time is repredented by decimals or fractions.
All systems base their date from day zero which us January 1, 1900 = 1, and January 2, 1900 = 2 and so on.
On the excel worksheet you cab retrieve the current date snd time using today(). On vba you use Now instead. Todays date, in "0" or "General" number formatting should show a number that starts with 42..., which represents the number of days since January 1, 1900.
Since there are 24 hours within a day, if you wish to refer to 1 hour or 1:00 AM the fraction or decimal in the serial number is equalent to 1/24. 7:00 PM = 19/24
mod() is a formula or function that will return the remainder of a division. Remember that time is represented by decimals, you do not need the actual whole numbers.
You can use the mod() formula in vba by using "application.worksheetfunction." before any.
When you divide a date and time with 1 using mod() it will return the remainder which is the decimal portion of your date aka the time.
Comparing datevalue("1:00 PM") will not equal CDate("May 8, 2015 1:00 PM")
sub compare_dates()
dim date1 as date
dim date2 as date
dim str as string
str = activesheet.range("A1").value 'str = "11/18/2011 10:11:36 PM"
str = Left(str,Instr(str," ")-1) ' str = "11/18/2011"
date1 = str ' assign it to date1
str = activesheet.range("B1").value ' in the same way b1 cell value
str = left(str,instr(str," ")-1)
date2 = str
if date1 > date2 then
' do something
end if
end sub
Can't it be done by simply using .Text instead of .Value?
Dim date1 As Date
Dim date2 As Date
Dim date3 As Date
date1 = TimeValue(Range("A1").Text)
date2 = TimeValue(Range("B1").Text)
date3 = TimeValue(Range("C1").Text)
If date3 >= date1 And date3 <= date2 Then
'Yes!
Else
'No!
End If