I have 2 cells with time data that format as follows:
"A1" = Sep 01 2018 00:01:33.707
"A2" = Sep 01 2018 00:01:49.917
I need to create a button and method within excel VBA that will set "A3" cell to true if the time "A2" is more than "A1" by 90 seconds.
This is what i have so far but it does not work:
Sub Macro2()
Dim str1 As String, str2 As String
With Worksheets("sheet5")
str1 = .Cells(1, "A").Text
str2 = .Cells(2, "A").Text
'greater than 90m seconds in A3
.Cells(3, "A") = CBool(Abs((DateValue(Left(str1, 6) & "," & Mid(str1, 7, 5)) + _
TimeValue(Mid(str1, 13, 8)) + TimeSerial(0, 0, 1) * CDbl(Right(str1, 4))) - _
(DateValue(Left(str2, 6) & "," & Mid(str2, 7, 5)) + _
TimeValue(Mid(str2, 13, 8)) + TimeSerial(0, 0, 1) * CDbl(Right(str2, 4)))) > _
TimeSerial(0, 0, 90))
'actual absolute difference in A4
.Cells(4, "A") = Abs((DateValue(Left(str1, 6) & "," & Mid(str1, 7, 5)) + _
TimeValue(Mid(str1, 13, 8)) + TimeSerial(0, 0, 1) * CDbl(Right(str1, 4))) - _
(DateValue(Left(str2, 6) & "," & Mid(str2, 7, 5)) + _
TimeValue(Mid(str2, 13, 8)) + TimeSerial(0, 0, 1) * CDbl(Right(str2, 4))))
End With End Sub
The above gives error because Date functions works with system Locale, which in my case is Hebrew, while the Data is in English.
Another way that could help is to convert all the column "A" (which holds the dates) to a system local date that can be used with Date and time functions on VBA (don't know how to do that).
Please help
I have split your task into 3 functions.
a) a helper function converts the 3 characters of the month into an integer. It looks a little clumsy, there might be other approaches but the advantage of using a large Select Case is it is easy to understand and easy to adapt if month names in a different language arise:
Function getMonthFromName(monthName As String) As Integer
Select Case UCase(monthName)
Case "JAN": getMonthFromName = 1
Case "FEB": getMonthFromName = 2
Case "MAR": getMonthFromName = 3
Case "APR": getMonthFromName = 4
(...)
Case "SEP": getMonthFromName = 9
(...)
End Select
End Function
b) a function that converts the string into a date. It assumes the date format in the form you provided, but it is easily adapted if the format changes (for simplicity, the seconds are rounded)
Function GetDateFromString(dt As String) As Date
Dim tokens() As String
tokens = Split(Replace(dt, ":", " "), " ")
Dim day As Integer, month As Integer, year As Integer
month = getMonthFromName(CStr(tokens(0)))
day = Val(tokens(1))
year = Val(tokens(2))
Dim hour As Integer, minute As Integer, second As Double
hour = Val(tokens(3))
minute = Val(tokens(4))
second = Round(Val(tokens(5)), 0)
GetDateFromString = DateSerial(year, month, day) + TimeSerial(hour, minute, second)
End Function
c) A function that calculated the difference of the 2 dates in seconds. A date in VBA (and many other environments) is stored as Double, where the Date-Part is the integer part and the date is the remainder. This makes it easy to calculate with Date values.
Function DateDiffInSeconds(d1 As String, d2 As String) As Long
Dim diff As Double
diff = GetDateFromString(d2) - GetDateFromString(d1)
DateDiffInSeconds = diff * 24 * 60 * 60
End Function
Update to deal with milliseconds: Change the GetDateFromString-function. In that case, DateDiffInSeconds should return a double rather than a long.
Function GetDateFromString(dt As String) As Date
Const MillSecPerHour As Long = 24& * 60 * 60 * 1000
Dim tokens() As String
tokens = Split(Replace(Replace(dt, ".", " "), ":", " "), " ")
Dim day As Integer, month As Integer, year As Integer
month = getMonthFromName(CStr(tokens(0)))
day = Val(tokens(1))
year = Val(tokens(2))
Dim hour As Integer, minute As Integer, second As Integer, milli As Integer
hour = Val(tokens(3))
minute = Val(tokens(4))
second = Val(tokens(5))
milli = Val(tokens(6))
GetDateFromString = DateSerial(year, month, day) _
+ TimeSerial(hour, minute, second) _
+ milli / MillSecPerHour
End Function
For your information, I've done what you are doing in a slightly different (and easier) way:
In cell B2, I put the value 13/11/2018 11:44:00.
In cell B3, I put the value 13/11/2018 11:45:01.
(For both cells, the cell formatting has been set to d/mm/jjjj u:mm:ss).
In another cell, I put following formula:
=IF((B3-B2)*86400>90;TRUE;FALSE)
The formula is based on the idea that a datetime value is set, based on the idea that one day equals 1, and there are 86400 seconds in one day.
Like this, you can calculate time differences without needing VBA.
I think you are over-complicating it, try this to get an idea how to do it:
Sub Macro2()
Dim str1 As String, str2 As String
With Worksheets("sheet5")
.Range("b1:e1") = Split(Range("A1"), " ")
.Range("B2:e2") = Split(Range("A2"), " ")
End Sub
Use UDF.
Sub Macro2()
Dim str1 As String, str2 As String
Dim mySecond As Double, t1 As Double, t2 As Double, t3 As Double
mySecond = TimeSerial(0, 0, 90)
With Worksheets("sheet5")
str1 = .Cells(1, "A").Text
str2 = .Cells(2, "A").Text
t1 = ConvertTime(str1)
t2 = ConvertTime(str2)
t3 = t2 - t1
.Cells(3, "a") = Abs(t3) >= mySecond
End With
End Sub
Function ConvertTime(s As String)
Dim vS
vS = Split(s, " ")
ConvertTime = DateValue(vS(0) & "-" & vS(1) & "-" & vS(2)) + TimeValue(Split(vS(3), ".")(0))
End Function
Related
Is there a way to create an array of the last 12 months (Month/Year in "mmm-yy" format) based on Month/Year in "mmm-yy" from a variable?
Use Dateadd
Sub Demo()
Dim s As String, ar, n As Integer
s = Format(Date, "mmm-yy") ' default
s = InputBox("mmm-yy", "Input mmm-yy", s)
ar = PriorYear(s)
For n = 1 To 12: Debug.Print n, ar(n): Next
End Sub
Function PriorYear(s) As Variant
Dim ar(1 To 12) As String, dt As Date, n As Integer
dt = DateValue("01-" & s)
For n = 12 To 1 Step -1
dt = DateAdd("m", -1, dt)
ar(n) = Format(dt, "mmm-yy")
Next
PriorYear = ar
End Function
Please, try the more compact version, too:
Dim arr, d As Date: d = Date 'you can choose any date you need
arr = Application.Transpose(Evaluate("TEXT(DATE(" & Year(d) - 1 & ",row(" & month(d) & ":" & month(d) + 11 & "),1),""mmm-yy"")"))
Debug.Print Join(arr, "|")
I usually post an answer if OP proves that he tried something by his own and it is good to learn that this aspect is mandatory in our community. Even explain in words what you tried. I made an exception only for the challenging sake, since the question has already been answered...
This late post demonstrates how to get the last 12 month dates via Evaluate, based on a symbolic formula syntax like
{Text(Date(StartYear,Column(StartColumn:EndColumn),1),"mmm-yyyy")}
Extra feature: The function accepts an optional argument MonthsCount changing the default value of 12 last months to any other positive value.
Public Function LastNMonths(dt As Date, Optional MonthsCount As Long = 12)
'Purpose: get 1-dim array of last 12 month dates formatted "mmm-yy")
'a) get start date
Dim StartDate As Date: StartDate = DateAdd("m", -MonthsCount + 1, dt)
Dim yrs As Long: yrs = Year(dt) - Year(StartDate)
'b) get column numbers representing months .. e.g. "J:U" or "A:L"
Dim cols As String
cols = Split(Cells(, Month(StartDate)).Address, "$")(1)
cols = cols & ":" & Split(Cells(, Month(dt) + Abs(yrs * 12)).Address, "$")(1)
'c) evaluate dates .. e.g. Text(Date(2020,Column(J:U),1),"mmm-yyyy")
LastNMonths = Evaluate("Text(Date(" & Year(StartDate) & _
",Column(" & cols & "),1),""mmm-yyyy"")")
End Function
Example call
You might want to display the resulting "flat" array based on today's date input (ending currently in Sep-2021) within the VB Editor's immediate window by a joined list
Debug.Print Join(LastNMonths(Date), "|")
returning e.g.
Oct-2020|Nov-2020|Dec-2020|Jan-2021|Feb-2021|Mar-2021|Apr-2021|May-2021|Jun-2021|Jul-2021|Aug-2021|Sep-2021
Problem
The following [mcve] will output an array of arrays of week numbers between two dates. It works when both dates are on the same year, however, some years have 52 weeks and start within the last days of the last year. And others have 53 weeks.
An example of 52 weeks is the 2020 calendar:
Where the first week begins on Dec 30.
And the example of 53 weeks is the 2016 calendar:
That begins only on Jan 4th.
Code
The following code is commented and outputs an array of arrays with the week numbers.
Sub w_test()
Dim Arr() As Variant, ArrDateW() As Variant
'Initial Date
DateI = DateSerial(2015, 5, 5)
'Final Date
DateF = DateSerial(2017, 9, 20)
'Difference in weeks between DateI and DateF
weekDif = DateDiff("ww", DateI, DateF) + k - 1
i = Weekday(DateI)
d = DateI
'If not Sunday, go back to last week, to start the loop
If i <> 1 Then
d = DateAdd("d", -(i - 1), d)
End If
ReDim ArrDateW(weekDif)
ReDim Arr(2)
'Loop on all weeks between two dates to populate array of arrays
For i = 0 To weekDif
'Date
Arr(0) = d
'Trying to solve problem with New Year
If Application.WorksheetFunction.WeekNum(d) = 53 Then
flag = True
End If
If flag = False Then
Arr(1) = Application.WorksheetFunction.WeekNum(d)
Else
Arr(1) = Application.WorksheetFunction.WeekNum(DateSerial(Year(d) + 1, 1, 1))
flag = False
End If
'Year
Arr(2) = Year(d)
'Populate array of arrays
ArrDateW(i) = Arr
'Next Week Number
d = DateAdd("ww", 1, d)
Next i
'To stop with Ctrl+F8
Debug.Print d
End Sub
Question
2015 had 53 weeks, however the program outputs the following:
And between 2016 and 2017, the output is a mess:
How to fix the program to output these week numbers correctly?
I went about it somewhat differently, relying on built-in VBA functions to correctly calculate the week numbers. Read about ISO week numbers is this answer and see how I'm using the DataPart function -- though you can substitute your own version of Ron de Bruin's ISO week number function if you feel it's warranted.
A couple of quick side notes:
Always use Option Explicit
Try to use more descriptive variable names. YOU know what you're talking about NOW. In a few months, you'll struggle to remember what d and Arr mean (even if it seems obvious now). It's just a good habit and makes the code self-documenting.
My example below breaks the logic into a separate function with an optional parameter (just for fun) that would allow the caller to change the start of the week to a different day.
Code module:
Option Explicit
Sub w_test()
Dim initialDate As Date
Dim finaldate As Date
initialDate = #5/5/2015#
finaldate = #9/29/2017#
Dim weeks As Variant
weeks = WeekNumbers(initialDate, finaldate)
Debug.Print "There are " & UBound(weeks, 1) & " weeks between " & _
Format(initialDate, "dd-mmm-yyyy") & " and " & _
Format(finaldate, "dd-mmm-yyyy")
End Sub
Private Function WeekNumbers(ByVal initialDate As Date, _
ByVal finaldate As Date, _
Optional ByVal weekStart As VbDayOfWeek = vbSunday) As Variant
Dim numberOfWeeks As Long
numberOfWeeks = DateDiff("ww", initialDate, finaldate, weekStart, vbFirstFullWeek)
Dim startOfWeek As Date
If Weekday(initialDate) <> vbSunday Then
Dim adjustBy As Long
If Weekday(initialDate) > weekStart Then
adjustBy = Weekday(initialDate) - weekStart
Else
adjustBy = (Weekday(initialDate) + 7) - weekStart
End If
startOfWeek = DateAdd("d", -adjustBy, initialDate)
End If
Dim allTheWeeks As Variant
ReDim allTheWeeks(1 To numberOfWeeks)
Dim weekInfo As Variant
ReDim weekInfo(1 To 3)
Dim i As Long
For i = 1 To numberOfWeeks
weekInfo(1) = startOfWeek
weekInfo(2) = DatePart("ww", startOfWeek, weekStart, vbFirstFourDays)
weekInfo(3) = Year(startOfWeek)
allTheWeeks(i) = weekInfo
startOfWeek = DateAdd("ww", 1, startOfWeek)
Next i
WeekNumbers = allTheWeeks
End Function
I have a document with the following:
FullDateTime FullDate FullTime Day Month Year Hour Minute Second
dd/mm/yyyy hh:mm:ss AM/PM
and I would like to fill in the other columns using macros to split the first column and place the whole date, whole time, day, month, year, hour, minute and second in the other columns. FullDateTime is every five minutes and I want to the DateTime to run for a whole year. I imagine the code to look something like:
Sub Func()
Dim 5mindays as Integer = 12*24*365
Dim x As Integer
Dim date
Dim time
For x = 1 To 5mindays
Split(," ")
Split(,"/")
Split(,":")
.Offset(0,1) = date(0)
...
.Offset(0,8) = time(2)
Add the next FullDateTime field below the existing one (adding 5 minutes)
Next
But have no idea how to actually do it. Please give me some ideas on how to solve this. Thanks!
Try after setting the correct worksheet name and year to process,
Option Explicit
Sub funk()
Dim dt As Long, yr As Long, tm As Long, dttm As Double
yr = 2018
dt = DateSerial(yr, 1, 1)
With Worksheets("sheet6")
Do While Year(dt) = yr
Do While TimeSerial(0, tm * 5, 0) < 1
dttm = dt + TimeSerial(0, tm * 5, 0)
.Cells(tm + 1 + (dt - DateSerial(yr, 1, 1)) * 288, "A").Resize(1, 9) = _
Array(dttm, dt, dttm - dt, _
Day(dt), Month(dt), yr, _
Hour(dttm), Minute(dttm), 0)
tm = tm + 1
Loop
tm = 0
dt = dt + 1
Loop
With .Range(.Cells(1, "A"), .Cells(.Rows.Count, "I").End(xlUp))
.Columns("A").NumberFormat = "dd/mm/yyyy hh:mm:ss AM/PM"
.Columns("B").NumberFormat = "dd/mm/yyyy"
.Columns("C").NumberFormat = "hh:mm:ss"
.Columns("D:I").NumberFormat = "0"
End With
End With
End Sub
I'm trying to calculate the time elapsed with the total amount of months, Days and Hours together using Datediff function. Is it not possible?
DateDiff("d hh", datein, Now)
What can I do?
That's not possible as the interval parameter can only be a single string.
You will have to do a bit more work like get the difference in hours and if it's above 24 convert the part before decimal separator into days
Sub Main()
Dim d1 As Date
d1 = "15/10/2014 08:00:03"
Dim d2 As Date
d2 = Now
Dim hrsDiff As Long
hrsDiff = DateDiff("h", d1, d2)
MsgBox IIf(hrsDiff >= 24, _
hrsDiff \ 24 & " days " & hrsDiff Mod 24 & " hours", _
hrsDiff & " hours")
End Sub
This is rough and ready, but is just directional. You could make a user defined function. This one returns 1:2:22:15 as a string (but you could return a custom class instance with variables for months, days, hours, minutes). It doesn't account for date2 being before date1 (not sure what happens then), nor does it account for date1 only being a partial day (assumes date1 is midnight).
Function MyDateDiff(date1 As Date, date2 As Date) As String
Dim intMonths As Integer
Dim datStartOfLastMonth As Date
Dim datStartOfLastHour As Date
Dim datEndOfMonth As Date
Dim intDays As Integer
Dim intHours As Integer
Dim intMinutes As Integer
Dim strResult As String
' Strip of any time
datStartOfLastMonth = DateSerial(Year(date2), Month(date2), Day(date2))
' check the dates arent in the same month
If Not ((Month(date1) = Month(date2) And Year(date1) = Year(date2))) Then
' how many months are there
intMonths = DateDiff("m", date1, date2)
Debug.Print (intMonths)
' how many days difference are there
intDays = DateDiff("d", DateAdd("m", intMonths, date1), date2)
Debug.Print (intDays)
' how many hours difference are there
intHours = DateDiff("h", datStartOfLastMonth, date2)
Debug.Print (intHours)
' how many minutes different are there
datStartOfLastHour = datStartOfLastMonth + (DatePart("h", date2) / 24)
intMinutes = DateDiff("n", datStartOfLastHour, date2)
Debug.Print (intMinutes)
Else
' Dates are in the same month
intMonths = 0
Debug.Print (intMonths)
' how many days difference are there
intDays = DateDiff("d", date1, date2)
Debug.Print (intDays)
' how many hours difference are there
intHours = DateDiff("h", datStartOfLastMonth, date2)
Debug.Print (intHours)
' how many minutes different are there
datStartOfLastHour = datStartOfLastMonth + (DatePart("h", date2) / 24)
intMinutes = DateDiff("n", datStartOfLastHour, date2)
Debug.Print (intMinutes)
End If
strResult = intMonths & ":" & intDays & ":" & intHours & ":" & intMinutes
MyDateDiff = strResult
End Function
Testing this:
?MyDateDiff("01-SEP-2014", "03-Oct-2014 22:15:33")
Gives:
1:2:22:15
i.e. 1 month, 2 days, 22 minutes and 15 seconds.
Reverse testing this by adding the components back onto date1 gives:
?DateAdd("n",15,DateAdd("h",22,DateAdd("d",2,DateAdd("m",1,"01-SEP-2014"))))
= "03-Oct-2014 22:15:33"
If we try with 2 dates in the same month:
?MyDateDiff("01-SEP-2014", "03-SEP-2014 22:15:33")
We get:
0:2:22:15
Reverse testing this:
?DateAdd("n",15,DateAdd("h",22,DateAdd("d",2,DateAdd("m",0,"01-SEP-2014"))))
Gives:
03/09/2014 22:15:00
But you may want to account for dates being the wrong way round...and you may only want date1 to be counted as a partial date if it starts later in the day....as I say, just a thought.
Regards
i
This may give you some ideas to correct for days in month or leap year Feb
Private Sub CommandButton1_Click()
DoDateA
End Sub
Sub DoDateA()
Dim D1 As Date, D2 As Date, DC As Date, DS As Date
Dim CA: CA = Array("", "yyyy", "m", "d", "h", "n", "s", "s")
Dim Va%(7), Da(7) As Date, Ci%
D1 = Now + Rnd() * 420 ' vary the * factors for range of dates
D2 = Now + Rnd() * 156
If D1 > D2 Then
[b4] = "Larger"
Else
[b4] = " smaller"
DS = D1
D1 = D2
D2 = DS
End If
[d4] = D1
[e4] = D2
DC = D2
For Ci = 1 To 6
Va(Ci) = DateDiff(CA(Ci), DC, D1)
DC = DateAdd(CA(Ci), Va(Ci), DC)
Va(Ci + 1) = DateDiff(CA(Ci + 1), DC, D1)
If Va(Ci + 1) < 0 Then ' added too much
Va(Ci) = Va(Ci) - 1
DC = DateAdd(CA(Ci), -1, DC)
Cells(9, Ci + 3) = Va(Ci + 1)
Cells(8, Ci + 3) = Format(DC, "yyyy:mm:dd hh:mm:ss")
End If
Da(Ci) = DC
Cells(5, Ci + 3) = CA(Ci)
Cells(6, Ci + 3) = Va(Ci)
Cells(7, Ci + 3) = Format(Da(Ci), "yyyy:mm:dd hh:mm:ss")
Cells(10, Ci + 3) = DateDiff(CA(Ci), D2, D1)
Next Ci
End Sub
Our accounting software exports dates as 07262013 as text. To convert this string of text to date format, I normally type the formula
=IF(A2>10000000,DATE(VALUE(RIGHT(A2,4)),VALUE(LEFT(A2,2)),VALUE(MID(A2,3,2))),
DATE(VALUE(RIGHT(A2,4)),VALUE(LEFT(A2,1)),VALUE(MID(A2,2,2))))
each time I export data. I want to write a custom function as =convert_text(text) to complete the same function.
I came up with
Function Convert_Date(text)
If text > 10000000 Then
Convert_Date = Application.Date(Application.Value(Application.Right(text, 4)), Application.Value(Application.Left(text, 2)), Application.Value(Application.Mid(text, 3, 2)))
Else
Convert_Date = Application.Date(Application.Value(Application.Right(text, 4)), Application.Value(Application.Left(text, 1)), Application.Value(Application.Mid(text, 2, 2)))
End Function
Thank you so much in advance!
Lee
You are looking for the following:
Function Convert_Date(text)
' assuming text is of the form mmddyyyy
' or mddyyyy
Dim year As Integer, month As Integer, day As Integer, L As Integer
L = Len(text)
year = Val(Right(text, 4))
day= Val(Mid(text, L - 5, 2))
If L = 7 Then month= Left(text, 1) Else month= Left(text, 2)
' >>>>> the next line is there for debugging;
' >>>>> take it out once you are happy with the result
MsgBox "year: " & year & "; month: " & month & "; day: " & day
Convert_Date = DateSerial(year, month, day)
End Function
This returns the "date serial number". You then format the cell with the date format you want, and you're good to go. Note that using explicit extraction of year, month, day makes the code much more readable.
Note - if you wanted to be more general, you could specify the format as an optional second string; e.g. ddmmyyyy in which case you could search for these characters and use that to extract the date properly:
Function Convert_Date(text, Optional formatString)
' assuming text is of the form mmddyyyy
' alternatively specify the format with the second parameter
Dim L As Integer, ii As Integer
Dim yearString As String, monthString As String, dayString As String
If IsMissing(formatString) Then formatString = "ddmmyyyy"
L = Len(text)
For ii = 1 To L
c = Mid(formatString, ii, 1)
t = Mid(text, ii, 1)
If c = "d" Then dayString = dayString & t
If c = "m" Then monthString = monthString & t
If c = "y" Then yearString = yearString & t
Next ii
Convert_Date = DateSerial(Val(yearString), Val(monthString), Val(dayString))
End Function
=DATE(YEAR(A1),MONTH(A1),DAY(A1))
no need! its already there :) if you need to do this in a fx it could look like this
function convert_date(text As String) As Date
convert_date = EVALUATE("DATE(YEAR(text),MONTH(text),DAY(text))")
end function
quickest i can think of is
Public Function FUNNYDATE(text As String) As Date
Dim padded As String
padded = Format(text, "00000000")
FUNNYDATE = DateSerial(Right(padded, 4), Left(padded, 2), Mid(padded, 3, 2))
End Function
Also, not that you do but in case it comes up in certain suggested solutions, I would steer clear of using DATEVALUE("mm-dd-yyyy") as its result depends on the locale of the user. Always stick to DATESERIAL(year,month,day)