Determine if a given time is between start and end time - vba

I got two columns with Start and End times of shifts, I need a formula that returns if NOW() is on shift/off shift (eg. TRUE/FALSE)
Answers I found only using MEDIAN, AND+IF did not work as shift can start evening and finish day time. Anyone got an elegant solution for this?
Bare in mind cases when it is after midnight.

Use:
=MEDIAN(MOD($C$1,1),-AND(A2>B2,B2>MOD($C$1,1))+A2,AND(A2>B2,B2<MOD($C$1,1))+B2)=MOD($C$1,1)
You can replace all the $C$1 references with NOW(), or just put =NOW() in C1

Assuming you have =NOW() in C1 (which will include date and time) you can use this formula:
=(MOD(C$1,1)<B2)+(MOD(C$1,1)>A2)+(B2<A2)=2
This works because if the time in B2 is > the time in A2 [shift is on one day] then the first two conditions need to be TRUE....but if the time in B2 is < A2 [shift cuts across two days] then only one of those conditions needs to be TRUE (or can be TRUE). Either way 2 of the conditions need to be TRUE
If you use this formula in C1 which will return the current time without date
=NOW()-TODAY()
...then above formula can be shortened to this:
=(C$1<B2)+(C$1>A2)+(B2<A2)=2
see screenshot below

Since you tagged as vba & excel-vba, you can use a UDF:
Public Function onShift(rngStart As Date, rngEnd As Date) As Boolean
Application.Volatile
If rngStart > rngEnd Then
If Time < rngEnd Then 'After midnight & in-shift
rngStart = Date + rngStart - 1
rngEnd = Date + rngEnd
Else
rngStart = Date + rngStart
rngEnd = Date + rngEnd + 1
End If
If Now >= rngStart And Now <= rngEnd Then onShift = True
Else
If Time >= rngStart And Time <= rngEnd Then onShift = True
End If
End Function
But I would stick with worksheet functions as provided by Scott's answer.
The benefit of using a UDF however is that you are able to create easy-to-remember function names that does exactly what you need it to do.

Try:
=OR(AND(B2-A2<0,OR($C$1<=B2,$C$1-A2>=0)),AND($C$1>=A2,$C$1<=B2))
You can replace $C$1 with TEXT(NOW(),"hh:mm") to evaluate the current time.

Considering all compared values are in TIME format, you can try:
=MEDIAN(A2,IF(B2<A2,B2+1,B2),IF(C$1<A2,C$1+1,C$1))=IF(C$1<A2,C$1+1,C$1)
If however you need to compare it with current time using NOW(), you have to strip the time out of it like:
=NOW()-INT(NOW()) '/* this goes to C$1 */
I saw how well Scott did it and the logic is way too high (at least for me) so I decided to make something where the logic is pretty straight forward.

Related

Comparing Date and Time Values Taken from Now() Function

I have a table that users can log their use of a laboratory instrument. For the most basic function of logging current use, I have an error check that goes through a column that references the start and end times of the instrument use.
Basically, I want to compare the current time and the end time of the instrument use with previously submitted reservations/current instrument use. If the code detects that the current user input would interfere with a reservation, it changes the string value of "strCheckTime" from "ok" to "error".
Then a If Then statement later on registers that and prompts the user with a message box.
The code is listed below.
So far, I have not gotten it to work. No matter what Now() returns and what reservations are currently present, it will run through the If Then statement and change the string value of "strCheckTime" from "ok" to "error".
Any help would be most welcome!
'Defines and sets variables for current use/reservation check
Dim shtInstrument As Worksheet
Set shtInstrument = Worksheets(strShtName)
shtInstrument.Activate
Dim intCountEntries As Integer
intCountEntries = shtInstrument.Cells(shtInstrument.Rows.Count, "B").End(xlUp).Row
Dim CurrentTime As Date
Dim StartDate As Date
Dim StartTime As Date
Dim EndDate As Date
Dim EndTime As Date
Dim rngStart As Range
Dim rngEnd As Range
Dim strCheckTime As String
strCheckTime = "Ok"
'Checks if desired instrument use falls in time frame of current use or reservation
For Each rngStart In shtInstrument.Range("H9:H" & intCountEntries)
StartDate = DateValue(rngStart.Value)
StartTime = TimeValue(rngStart.Value)
EndDate = DateValue(rngStart.Offset(0, 1).Value)
EndTime = TimeValue(rngStart.Offset(0, 1).Value)
If StartDate <= Date <= EndDate Then
If StartTime <= Now() <= EndTime Then
strCheckTime = "Error"
ElseIf StartTime <= CurrentTime + TimeSerial(0, txtSample.Text * txtTime.Text, 0) <= EndTime Then
strCheckTime = "Error"
Else
strCheckTime = "Ok"
End If
Else
'Do nothing
End If
Next rngStart
The problem is in this line:
If StartTime <= Now() <= EndTime Then
The function "Now()" returns the entire date, including the time. This value is inherently always greater than the StartTime variable which represents only a time.
The second problem (that you figured out and mentioned in a comment) is that you can't use the equality operators like this.
The statement:
If x <= y <= z
will be evaluated as such:
If (x <= y) <= z
So this will be evaluated to:
If (TRUE/FALSE) <= z Then
But TRUE = -1 and FALSE = 0 so as long as z is bigger than z (which in your case it always is), your function will return true. You need to split the statements (again, per your comment).
You need to use either:
If StartTime <= Time() AND Time() <= EndTime Then
or
If StartTime <= TimeValue(Now()) AND TimeValue(Now()) <= EndTime Then
Better yet, you don't need to use the Date and Time separately:
StartTime = [cell where date and time are located]
EndTime = [cell where date and time are located]
If StartTime <= Now() AND Now() <= EndTime Then 'both time variables are defined by both the date and time
Note that to figure out problems like this, it is best to use a line such as:
debug.print StartTime
debug.print Now()
debug.print EndTime
debug.print (StartTime <= Now() <= EndTime)
to pinpoint where the problem is.
One additional comment is that if you are using things such as the Time throughout code, the Time function is evaluated when the code runs. So if you have a procedure that takes a bunch of time and at the beginning you check the time vs something and then at the end you use the Time/Date function to get the time to record somewhere, these values will be different. The best way to prevent this is to create a variable at the beginning of the code (or wherever you want to check the time:
currTime = Now()
and then use this variable throughout your code. In this particular case, the difference will either be extremely negligible or nonexistent as the check is in the same line of code, but in other cases it could be an issue.
EDIT***To include the additional problem of not being able to use equalities like this.

Get the last day of month

I want to get the last day of the month.
This is my code. If I want to debug it and compile it to the database it says it has an error in the syntax.
Public Function GetNowLast() As Date
Dim asdfh As Date
asdfh = DateValue("1." _
& IIf(Month(Date) + 1) > 12, Month(Date) + 1 - 12, Month(Date) + 1) _
&"."&IIf(Month(Date)+1)>12 , Year(Date)+1,Year(Date))
asdf = DateAdd("d", -1, asdf)
GetNowLast = asdf
End Function
GD Linuxman,
Let's focus on obtaining the result...:-)
See also: here
The comment by #Scott Craner is spot on ! Though strictly speaking there is no need to use the formatting. (Assuming you want to work with the 'Date' object)
To achieve what you want, setup the function as per below:
Function GetNowLast() as Date
dYear = Year(Now)
dMonth = Month(Now)
getDate = DateSerial(dYear, dMonth + 1, 0)
GetNowLast = getDate
End Function
You can call the function in your code as:
Sub findLastDayOfMonth()
lastDay = GetNowLast()
End Sub
Alternatively, and neater is likely:
Function GetNowLast(inputDate as Date) as Date
dYear = Year(inputDate)
dMonth = Month(inputDate)
getDate = DateSerial(dYear, dMonth + 1, 0)
GetNowLast = getDate
End Function
You can call that function and pass it an input parameter.
Sub findLastDayOfMonth()
lastDay = GetNowLast(Now()) 'Or any other date you would like to know the last day of the month of.
End Sub
See also this neat solution by #KekuSemau
Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim d1 As String
Set Rng = Range("A2")
d1 = Range("a2").Value2 'put a date in A2 Formatted as date(cell format)
Dim years
Dim months
Dim end_month
years = year(d1)
months = month(d1)
end_month = Day(DateSerial(years, months + 1, 1 - 1)) 'add one month and subtract one day from the first day of that month
MsgBox CStr(end_month), vbOKOnly, "Last day of the month"
End Sub
I realize this is a bit late into the conversation, but there is an already available worksheet function that gives the end of month date, EoMonth().
Pasting into the Immediate Window:
?Format(CDate(WorksheetFunction.EoMonth(Date, 0)), "dd")
Will return the last day of the month based on current date.
As a UDF, it makes sense to give it a default Argument:
Function LastDay(Optional DateUsed As Date) As String
If DateUsed = Null Then DateUsed = Date
LastDay = Format(CDate(WorksheetFunction.EoMonth(DateUsed, 0)), "dd")
Debug.Print LastDay
End Function
If you feed it Arguments, be sure that they are Date Literals (i.e. Enclosed with #s)
LastDay(#3/10#)
Result: 31
LastDay #2/11/2012#
Result: 29 '(A leap Year)
Note the output Data Type is String (not Date) and that the format of the date can be adjusted as needed (Ex: "mm/dd/yyyy" instead of "dd").
If the Date Data Type is needed, use:
Function LastDay(Optional DateUsed As Date) As Date
If DateUsed = 0 Then DateUsed = Date
LastDay = WorksheetFunction.EoMonth(DateUsed, 0)
Debug.Print CDate(LastDay)
End Function
I hope that helps someone.
In short, a great and straightforward approach is to find the first day of the following month and then move backward one day.
Make yourself a little function that does something like this:
Obtain the month and year in question (the one where you want the last day)
Use DateSerial to combine the month and the year, along with the day "1" to get the first day of the month in question.
Use DateAdd to add one month. This will get you the first day of the next month (which is one day after the date you really want).
Use DateAdd again to subtract (move back) one day. This will give you the last day of the month where you started.
Function eom(ByVal input_date As Date) As Date
' take the first day of the month from the input date, add one month,
' then back up one day
eom = DateAdd("d", -1, DateAdd("m", 1, DateSerial(Year(input_date), Month(input_date), 1)))
End Function
In Access VBA, you can call Excel's EOMonth worksheet function (or almost any of Excel's worksheet methods) is by binding to an Excel application object and a WorksheetFunction object, which can be accomplished in a few ways.
Calling Excel functions with an Late Bound object
The shortest method from Access VBA is with a single line of code using a late-bound object. This example returns the date of the last day of the current month:
MsgBox CreateObject("Excel.Application").WorksheetFunction.EOMonth(Now(), 0)
A more verbose method, as a function:
Function eoMonth_LateBound(dt As Date) As Date
Dim xl As Object
Set xl = CreateObject("Excel.Application")
eoMonth_LateBound = xl.WorksheetFunction.eomonth(dt, 0)
Set xl = Nothing
End Function
An issue with late-bound references is that VBA takes a second to bind the object each time the function is called. This can be avoided by using early binding.
Calling Excel functions with an Early Bound object
If the function is to be used repeatedly, it's more efficient to go with Early Binding and retain the object between calls, for example:
Go Tools > References and add a reference to "Microsoft Excel x.xx Object Library" (use whatever the newest version number is that you have installed).
Add this code in a new module:
Option Compare Database
Option Explicit
Dim xl As Excel.Application
Function eoMonth_EarlyBound(dt As Date) As Date
If xl Is Nothing Then Set xl = New Excel.Application
eoMonth_EarlyBound = xl.WorksheetFunction.eomonth(dt, 0)
End Function
Sub demo()
MsgBox eoMonth_EarlyBound(Now())
MsgBox eoMonth_EarlyBound("4/20/2001")
End Sub
Creating a WorksheetFunction object
If Excel's worksheet functions are to be used lots throughout your code, you could even create a WorksheetFunction object to simplify the calls. For example, this could be a simple way to join multiple strings with TEXTJOIN, or get a response from an API with WEBSERVICE:
Sub Examples()
'requires reference: "Microsoft Excel x.xx Object Library"
Dim xl As Excel.Application, wsf As Excel.WorksheetFunction
Set xl = New Excel.Application
Set wsf = xl.WorksheetFunction
'use EOMONTH to return last date of current month
Debug.Print CDate(wsf.eomonth(Now(), 0))
'use WEBSERVICE return your current IP address from a free JSON API
Debug.Print wsf.WebService("https://api.ipify.org")
'use TEXTJOIN to implode a bunch of values
Debug.Print wsf.TextJoin(" & ", True, "join", "this", , "and", , "that", "too")
'always tidy up your mess when finished playing with objects!
Set wsf = Nothing
Set xl = Nothing
End Sub
Note that these functions may require Excel 2016+ or Excel 365 (aka: Object Library 16.0+.)
Another method I used was:
nMonth = 2
nYear = 2021
lastDayOfMonth = DateSerial(nYear, nMonth + 1, 0)

Excel VBA yearfrac with mins and maxes

I'm trying to find the number of weeks between two dates in Excel VBA (with some min/max functionality in between), was getting Type Mismatch error (Run-time error '13') for the following line:
WeeksWorked = Application.WorksheetFunction.RoundDown _
(52 * Application.WorksheetFunction.YearFrac _
(Application.WorksheetFunction.Max(DOH, DateValue("Jan 1, 2012")), _
DateValue("Dec 31, 2012")), 0)
Anyone have any direction as to what I'm doing wrong, it would be greatly appreciated!
Not sure why do you need to use this in VBA, here is something you can try.
In Excel:
Assuming Start Date is in A1, End Date is in A2, then A3,
=(NETWORKINGDAYS(A1,A2))/5
Now that is in the perspective of business days, thus giving 5 day week. If you need 7 day week with regular days,
=WEEKNUM(A3)-WEEKNUM(A2)
The function WEEKNUM() in the Analysis Toolpack addin calculates the correct week number for a given date, if you are in the U.S. The user defined function below will calculate the correct week number depending on the national language settings on your computer.
If you still need to use VBA try this: (as Tim pointed out DateDiff pretty handy.) Or you can even use Evaluate to trigger WEEKNUM.
Option Explicit
Function numWeeks(startDate As Date, endDate As Date)
numWeeks = DateDiff("ww", startDate, endDate)
End Function
Using Evaluate on WEEKNUM:
Function numWeeks(startDate As Range, endDate As Range)
Dim s As Integer, t As Integer
s = Application.Evaluate("=WEEKNUM(" & startDate.Address & ",1)")
t = Application.Evaluate("=WEEKNUM(" & endDate.Address & ",1)")
numWeeks = t - s
End Function
Reference for Excel VBA DataTime Functions
As suggested in the comments you could just do:
debug.print DateDiff("ww", DateValue("Jan 1, 2012"), DateValue("Dec 31, 2012"))
If for some reason you wanted to roll your own you could truncate the quotient of:
| day1 - day2 |
---------------
7
Example code:
Sub test_numWeeks_fn()
Call numWeeks(DateValue("Jan 1, 2012"), DateValue("Dec 31, 2012"))
End Sub
Function numWeeks(d1 As Date, d2 As Date)
Dim numDays As Long
numDays = Abs(d1 - d2)
numWeeks = Int(numDays / 7)
Debug.Print numWeeks
End Function
Result:
52
Try below code :
Sub example()
Dim dob As Date
dob = #7/31/1986#
Dim todaydt As Date
todaydt = Date
Dim numWeek As Long
numWeek = DateDiff("ww", dob, todaydt) ' Difference in weeks
End Sub

Comparing Times in vb.net

I have four different DateTime boxes. Two boxes just displays the Date and the other two just Displays the time
If the current time is between midnight and six am I want the Date in the date box to be the day before.
I have it all, I'm just missing the part that compares the two.
Dim currentTime As DateTime = Now
'default date
If deMaxDate.Value = Nothing Then
deMaxDate.Value = Now
End If
If deMinDate.Value = Nothing Then
If currentTime.Hour < TimeOfDay.Hour Then
'THIS IF STATMENT IS WRONG - HOW CAN I CHECK IF ITS BETWEEN 12AM AND 6 HERE
deMinDate.Value = (Now - TimeSpan.FromDays(1))
Else
deMinDate.Value = Now
End If
End If
'default time
If teMaxTime.Value = Nothing Then
teMaxTime.Value = Now
End If
If teMinTime.Value = Nothing Then
teMinTime.Value = (Now - TimeSpan.FromHours(6))
End If
My comment by the third if statment is where I'm stuck at.
DateTime is a double datatype? Something like
if currentTime.Hour < TimeOfDay.Hour.Equals(6)
?
Your rule, if I understand this, is that you want to look at the current time. If the current time is between 12AM(0000) and 6AM(0600), then you want to use yesterday as the active date.
Dim current as DateTime = now()
Dim activeDate as DateTime = current
if current.Hour < 6 then
activeDate = current.AddDays(-1)
end if
Although, if you're not really interested in the hours part of the date except for this business rule, you could always just do date.AddHours(-6).
I do this in a similar situation where I want to check the current time is prior to 4 AM.
If (DateTime.Now.Hour < 4) Then
'do something
End If
Just use
If currentTime.Hour <= 6 Then
deMinDate.Value = Now.AddDays(-1)
Else
deMinDate.Value = Now
End If
or indeed...
If currentTime.Hour <= 6 Then
deMinDate.Value = Now.Date.AddDays(-1)
Else
deMinDate.Value = Now.Date
End If
if you don't want the time bit because .Now contains a time element as well as a date element.
Have a look at http://msdn.microsoft.com/en-us/library/5ata5aya.aspx. It might apply to your case
currentTime.Hour < TimeOfDay.Hour.Equals(6)
ended up being the answer

Dates in For Loop in vb.net

In vb.net I have two data values as shown below:
Dim startp as datetime
Dim endp as datetime
I have a function called ProcessData(soemdate) which processes dataporting.
In VB.net is there a way I can do something like
For each day between startp and endp
ProcessData(soemdate)
Next
Thanks
Here is another way to do this.
Dim startP As DateTime = New DateTime(2009, 1, 1)
Dim endP As DateTime = New DateTime(2009, 2, 1)
Dim CurrD As DateTime = startP
While (CurrD <= endP)
ProcessData(CurrD)
Console.WriteLine(CurrD.ToShortDateString)
CurrD = CurrD.AddDays(1)
End While
For Each Day As DateTime in Enumerable.Range(0, (endp - startp).Days) _
.Select(Function(i) startp.AddDays(i))
ProcessData(Day)
Next Day
Adding to Joel Coehoorn's answer which I personally think should be the accepted answer as I always try to avoid While loops no matter how safe they may appear. For...Each is a much safer approach although the enumerable isn't very pretty in-line. You can however move it to a function to keep things more readable, plus you can re-use as needed.
For Each Day As DateTime In DateRange(StartDate, EndDate)
ProcessData(Day)
Console.WriteLine(Day.ToShortDateString)
Next
Public Shared Function DateRange(Start As DateTime, Thru As DateTime) As IEnumerable(Of Date)
Return Enumerable.Range(0, (Thru.Date - Start.Date).Days + 1).Select(Function(i) Start.AddDays(i))
End Function
I also added 1 to Enumerable range since as Joel had it, it wouldn't return the end date and in my situation I needed it to return all dates in the range including the start and end days.
Enumerable.Range is a sort of loop in itself that adds i days to the startdate advancing i with each call from in this case 0 to the difference between start and end days + 1. So the first time it's called you get the result of Start.AddDays(0), next you'll get Start.AddDays(1) and so on until the range is complete.
You can easily loop through each day if you convert your dates to OLE Automation Date OADate where the left portion represents the day and the right portion represents the time.
For example #06/19/2018#.ToOADate converts to 43270.0
For loopDate As Double = #06/19/2018#.ToOADate To #07/01/2018#.ToOADate
Dim thisDate As Date = DateTime.FromOADate(loopDate)
' Do your stuff here e.g. ProcessData(thisDate)
Next
Yes, you can use an accumulator date:
Dim Accumulator as DateTime
Accumulator = startp
While (Accumulator <= endp)
Accumulator = Accumulator.AddDays(1)
End While
Not tested, and I'm a C# programmer, so be easy if my syntax is wrong.
For those that come looking later, I had to add a +1 to the Range endpoint to get this to work for when the start and end were the same. Here is the code I used.
For Each Day As DateTime in Enumerable.Range(0, (endp - startp).Days + 1) .Select(Function(i) startp.AddDays(i))
'Do work here
Next Day
Set a calendar table with all dates and query values from there.
SQL:
Select Date as MyDate from tblCalendar Where Date >= StartDt And Date <= EndDate
.NET:
While Reader.read
process(MyDate)
End While