I have a code that gets an ETA (estimated time of arrival) but I want it to exclude weekends. I also have it to change the ETA if its past 2:30PM.
Code:
Dim ETA1 As Date = Date.Today.AddDays(1)
Dim ETA2 As Date = Date.Today.AddDays(2)
Dim ETA3 As Date = Date.Today.AddDays(3)
Dim day As String = Format(Today, "dddd")
Dim time As Date
Dim CurrHour As Integer
Dim CurrMinute As Integer
time = DateTime.Now
CurrHour = time.Hour
CurrMinute = time.Minute
If StoreBox.Text Like "25*" Then
MicroLabel.Visible = True
If CurrHour >= 2 AndAlso CurrMinute >= 30 Then
ETABox.Text = ETA2
Else
ETABox.Text = ETA1
End If
Else
MicroLabel.Visible = False
If CurrHour >= 2 AndAlso CurrMinute >= 30 Then
ETABox.Text = ETA2
Else
ETABox.Text = ETA1
End If
End If
DateTime is a very flexible type which allows you to easily perform many date/time related actions. You don't need to perform a string-like analysis (what your code is doing).
For example, to take care of the two requested functionalities, just do something like:
Dim curTime As DateTime = Now
Dim goAhead As Boolean = True
If curTime.DayOfWeek = DayOfWeek.Saturday OrElse curTime.DayOfWeek = DayOfWeek.Sunday Then
goAhead = False
ElseIf curTime > New DateTime(curTime.Year, curTime.Month, curTime.Day, 14, 30, 0) Then
goAhead = False
End If
If goAhead Then
'Weekday before 2:30 PM
End If
Related
I have a table that populates with an ID,Closed and Reopen Date. If I edit the date range for a particular ID. I need a way to check for overlapping dates across ALL date ranges in the table against the desired ID I changed. I have tried this below but am only evaluating on a row by row basis. Given the example below how could I get for example ID 2 to evaluate across all 6 rows if i changed closed to 9/17/2017?
Dim b As String = ddlB.SelectedValue
Dim l As String = ddlL.SelectedValue
Dim evaluatedID As Integer = ID.Value
Dim evaluatedClosedDate As Date = rdpCloseDate.SelectedDate
Using sta As New dsdMyDataset.MyTableAdapter
sta.Connection = My.DataHandler.MyDBConnection
Dim tbl As New dsdMyDataset.MyDataTable
sta.Fill(tbl, b, l)
For Each row In tbl
If evaluatedID < row.ID And evaluatedClosedDate < row.ReopenedDate Then
Return False
ElseIf evaluatedID = row.ID And evaluatedClosedDate < row.ReopenedDate Then
Return False
ElseIf evaluatedID > row.ID And evaluatedClosedDate > row.ReopenedDate Then
Return False
ElseIf evaluatedID = Nothing OrElse evaluatedClosedDate = Nothing OrElse row.ReopenedDate = Nothing Then
Return False
Else
Return True
End If
Next
End Using
I am trying to find the fourth Wednesday of the current Month and Year when a form loads
I have converted numerous C# code to Visual Basic with no results
Would someone explain what is wrong with this code OR explain how to accomplish this in VB Code
Private Sub SurroundingSub()
Dim thisDate As Date = Today
tbMonth.Text = thisDate.ToString("MMMM")
tbYear.Text = thisDate.ToString("yyyy")
Dim month As Integer
month = tbMonth.Text
Dim year As Integer
year = tbYear.Text
Dim fourthWed As Date = New Date(year, month, 4)
tbFour.Text = fourthWed.ToLongDateString
While fourthWed.DayOfWeek <> DayOfWeek.Wednesday
fourthWed = fourthWed.AddDays(1)
tbFour.Text = fourthWed.ToShortDateString
End While
End Sub
This is a JavaFX statement that I am trying to implement in VB.Net
if(TorF.equals("F") && today.isAfter(fourthTUEofMONTH))
This sets the date
public void setDATES() throws IOException, SQLException{
today = LocalDate.now();
fourthTUEofMONTH = LocalDate.now();
fourthTUEofMONTH = fourthTUEofMONTH.with(TemporalAdjusters.dayOfWeekInMonth(4, DayOfWeek.TUESDAY));
endMONTH = LocalDate.now();
endMONTH = endMONTH.with(TemporalAdjusters.lastDayOfMonth());
}
For a more general solution, with my function you can easily find the first, second, third, forth or fifth sunday, monday, tuesday, wednesday or whatever you want:
Public Function GetXDayOfWeek(Day As DateTime,
DayOfWeek As DayOfWeek,
Optional Index As Integer = 1) As DateTime
Dim First As New Date(Day.Year, Day.Month, 1)
Dim Diff As Integer = (DayOfWeek - First.DayOfWeek + 7) Mod 7
Return First.AddDays(Diff + (Index - 1) * 7)
End Function
So if you want to find the forth wednesday of the current month, use it like:
Dim DateToFind As DateTime = GetXDayOfWeek(Today, DayOfWeek.Wednesday, 4)
Your while statement will stop on the first Wednesday it finds, not the fourth. Keep track of the number of Wednesdays you encounter as you iterate and once you find the fourth then you can update tbFour.
Also as mentioned in the comments you'll want to start at the first day of the year.
Dim fourthWed As Date = New Date(year, month, 1)
Dim wednesdayCursor As Integer = 0
While wednesdayCursor < 4
If fourthWed.DayOfWeek = DayOfWeek.Wednesday Then
wednesdayCursor += 1
End If
fourthWed = fourthWed.AddDays(1)
End While
'Subtract one day because we added one on loop:
fbFour.Text = fourthWed.AddDays(-1).ToShortDateString()
You should make the function of getting the fourth Wednesday into a separate method, perhaps generalizing it for any day of the week, but just for the fourth Wednesday...
Module Module1
Function FourthWedOfMonth(dt As DateTime) As Integer
Dim currDate = New DateTime(dt.Year, dt.Month, 1)
Dim nWednesdays = 0
While nWednesdays < 4
If currDate.DayOfWeek = DayOfWeek.Wednesday Then
nWednesdays += 1
End If
currDate = currDate.AddDays(1)
End While
Return currDate.Day - 1
End Function
Sub Main()
For mo = 1 To 12
Console.Write(FourthWedOfMonth(New DateTime(2020, mo, 17)) & " ")
Next
Console.ReadLine()
End Sub
End Module
Outputs the correct days for 2020:
22 26 25 22 27 24 22 26 23 28 25 23
If you wanted the DateTime of the fourth Wednesday, you could
Function FourthWedOfMonth(dt As DateTime) As DateTime
Dim currDate = New DateTime(dt.Year, dt.Month, 1)
Dim nWednesdays = 0
While nWednesdays < 4
If currDate.DayOfWeek = DayOfWeek.Wednesday Then
nWednesdays += 1
End If
currDate = currDate.AddDays(1)
End While
Return New DateTime(dt.Year, dt.Month, currDate.Day - 1)
End Function
and then Console.WriteLine(FourthWedOfMonth(DateTime.Today).ToString("dd-MMM-yyyy")) would output "22-Jul-2020" (at the time of writing).
I'd find the fourth Wednesday of the current month this way:
Private Sub FourthWednesdayOfCurrentMonth()
Dim firstOfMonth As DateTime = DateTime.Today.AddDays(-1 * (DateTime.Today.Day - 1))
Dim firstWednesday As DateTime = firstOfMonth.AddDays((7 + (DayOfWeek.Wednesday - firstOfMonth.DayOfWeek)) Mod 7)
Dim fourthWednesday As DateTime = firstWednesday.AddDays(21)
tbYear.Text = fourthWednesday.Year
tbMonth.Text = fourthWednesday.Month
tbFour.Text = fourthWednesday.Day
End Sub
Written generically for any day of the week, that would change to:
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim fourthWednesday As DateTime = FourthWeekDayOfCurrentMonth(DayOfWeek.Wednesday)
tbYear.Text = fourthWednesday.Year
tbMonth.Text = fourthWednesday.Month
tbFour.Text = fourthWednesday.Day
End Sub
Private Function FourthWeekDayOfCurrentMonth(ByVal WeekDay As DayOfWeek) As DateTime
Dim firstOfMonth As DateTime = DateTime.Today.AddDays(-1 * (DateTime.Today.Day - 1))
Dim firstWeekday As DateTime = firstOfMonth.AddDays((7 + (WeekDay - firstOfMonth.DayOfWeek)) Mod 7)
Return firstWeekday.AddDays(21)
End Function
Given today's date want to get the date of the each Friday for the last four weeks.
Here is an easy LINQ approach:
Dim today = Date.Today
Dim lastFridays = From d In Enumerable.Range(0, Int32.MaxValue)
Let dt = today.AddDays(-d)
Where dt.DayOfWeek = DayOfWeek.Friday
Select dt
Dim lastFourFridays As Date() = lastFridays.Take(4).ToArray()
Since it's not the most efficient approach, here is a query that is still readable and maintainable but only searches the first friday and then takes only every 7th day:
Dim lastFriday = lastFridays.First() ' reuse of above query '
Dim fridays = From d In Enumerable.Range(0, Int32.MaxValue)
Let dt = lastFriday.AddDays(-d * 7)
Select dt
Dim lastFourFridays As Date() = fridays.Take(4).ToArray()
You may consume this one, which returns a list of such dates and excludes the one if the specifiedDate date is Friday:
Public Shared Function GetLastFourFridays(specifiedDate As DateTime) As List(Of DateTime)
Dim dtm As New List(Of DateTime)()
Dim dt As DateTime = specifiedDate
For i As Integer = 0 To 6
dt = dt.AddDays(-1)
If dt.DayOfWeek = DayOfWeek.Friday Then
dtm.Add(dt)
Exit For
End If
Next
dtm.Add(dt.AddDays(-7))
dtm.Add(dt.AddDays(-14))
dtm.Add(dt.AddDays(-21))
Return dtm
End Function
and the way you use it is:
Dim dtm As List(Of DateTime) = GetLastFourFridays(DateTime.Now)
For Each d As var In dtm
Console.WriteLine(String.Format("Date: {0}, Day: {1}", d.ToString(), [Enum].Parse(GetType(DayOfWeek), d.DayOfWeek.ToString())))
Next
Here is my way:
Function Last4Friday(ByVal StartDate As Date) As array
Dim L4F()
Dim mDate as date = StartDate
For value As Integer = 1 To 7
mDate = mDate.AddDays(-1)
If mDate.DayOfWeek = DayOfWeek.Friday Then
L4F = {mDate, mDate.AddDays(-7), mDate.AddDays(-14), mDate.AddDays(-21)}
exit for
End If
Next
Return L4F
End Function
Edit: If you need to check the inserted date and you want it returned in the array you may simply use:
Dim mDate as date = StartDate.AddDays(1)
instead of
Dim mDate as date = StartDate
Try this. It doesn't use a loop to find the starting Friday.
Dim someDate As DateTime = DateTime.Now
If someDate.DayOfWeek <> DayOfWeek.Friday Then
'do the math to get a Friday
someDate = someDate.AddDays(DayOfWeek.Friday - someDate.AddDays(1).DayOfWeek - 6)
End If
Dim last4Fridays As New List(Of DateTime) From {someDate, someDate.AddDays(-7), someDate.AddDays(-14), someDate.AddDays(-21)}
All of the other suggestions have used a loop to find the starting Friday. If this code is used infrequently then how the starting Friday is determined might not matter.
edit: as function
Function FindLastFourFridays(someDate As DateTime) As List(Of DateTime)
'Find first Friday to include
If someDate.DayOfWeek <> DayOfWeek.Friday Then
someDate = someDate.AddDays(DayOfWeek.Friday - someDate.AddDays(1).DayOfWeek - 6)
' uncomment these two lines if you do not want initial someDate.DayOfWeek = DayOfWeek.Friday to be included
'Else
' someDate = someDate.AddDays(-7)
End If
'build the return (four fridays)
Dim last4Fridays As New List(Of DateTime) From {someDate, someDate.AddDays(-7), someDate.AddDays(-14), someDate.AddDays(-21)}
Return last4Fridays
End Function
This function does not need to be passed a date it picks up today's date and gets the last four Friday's from today. It can be changed around to get any day of the week.
Dim todaysDate As Date = Date.Today
Dim oldDay As Integer
Dim thisWeek As Date
Dim firstWeek As Date
Dim secondWeek As Date
Dim thirdWeek As Date
Dim fourthWeek As Date
'finds the Friday of the end of the current week No mattter what day you are working
Dim daycount As Integer
'use this to check specific dates "Dim datetime As New DateTime(2015, 4, 13)"
oldDay = Weekday(todaysDate)
thisWeek = todaysDate
If oldDay < 6 Then
daycount = 6 - oldDay
thisWeek = thisWeek.AddDays(+daycount)
ElseIf oldDay > 6 Then
daycount = oldDay - 6
thisWeek = thisWeek.AddDays(-daycount)
End If
Dim currentDate As Date = Now
Do While Not currentDate.DayOfWeek = DayOfWeek.Friday
currentDate = currentDate.AddDays(-1)
Loop
fourthWeek = currentDate.AddDays(-21)
thirdWeek = currentDate.AddDays(-14)
secondWeek = currentDate.AddDays(-7)
firstWeek = currentDate
I am trying to implement a method in VB.NET that could subtract a start datetime and datetime, and result this specific string period "D.HH:mm:ss", observing that the day doesn't have 24 hours, but only 8 hours.
My function to do the subtract return only the diff in hours and as decimal:
Public Function WH(ByVal date1 As Date, ByVal date2 As Date,
Optional ByVal considerwk As Boolean = True) As Decimal
Dim ini_tim As DateTime = DateTime.Parse("08:00")
Dim end_tim As DateTime = DateTime.Parse("18:00")
'//RESULT
Dim _res As Integer
'//WHILE INITIAL LESS THAN END...
Do While date1 <= date2
'//INSIDE INTERVAL?
If Hour(date1) >= Hour(ini_tim) And Hour(date1) <= Hour(end_tim) Then
'//CONSIDER WORKDAY?
If considerwk = True Then
'//IF NOT SATURDAY OR SUNDAY
If Weekday(date1) <> vbSaturday And Weekday(date1) <> vbSunday Then
'//ADD +1 IN RESULT
_res += 1
End If
Else
'//ADD +1 IN RESULT
_res += 1
End If
End If
'//ADD A MINUTE IN THE DATE
date1 = DateAdd("n", 1, date1)
Loop
'//RETURN THE DIFF IN DEC
Return CDec(_res / 60)
End Function
Hope that you can help me!
Thanks!
Something to consider...
With your current code:
Hour(date1) <= Hour(end_tim)
A time of 18:01 would be considered "inside the interval" when it's actually after the end time!
Try something more like below. It'll be accurate down to the second and can handle it if your start/stop times are not exactly at the top of the hour (like 08:30 to 18:30):
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim dt1 As DateTime = DateTime.Now
Dim dt2 As DateTime = dt1.AddDays(5).AddHours(4).AddMinutes(39).AddSeconds(17)
Dim ts As TimeSpan = WH(dt1, dt2, True)
Dim strFormattedTotal As String = String.Format("{0}.{1}:{2}:{3}", ts.Days, ts.Hours.ToString("00"), ts.Minutes.ToString("00"), ts.Seconds.ToString("00"))
Label1.Text = "Total: " & strFormattedTotal
Label2.Text = "Total Hours: " & ts.TotalHours
End Sub
Public Function WH(ByVal date1 As Date, ByVal date2 As Date, Optional ByVal considerwk As Boolean = True) As TimeSpan
Static ini_tim As DateTime = DateTime.Parse("08:00")
Static end_tim As DateTime = DateTime.Parse("18:00")
Dim TS As New TimeSpan
Do While date1 < date2
If date1.TimeOfDay >= ini_tim.TimeOfDay AndAlso date1.TimeOfDay <= end_tim.TimeOfDay Then
If considerwk Then
If date1.DayOfWeek <> DayOfWeek.Saturday AndAlso date1.DayOfWeek <> DayOfWeek.Sunday Then
TS = TS.Add(TimeSpan.FromSeconds(1))
End If
Else
TS = TS.Add(TimeSpan.FromSeconds(1))
End If
End If
date1 = date1.AddSeconds(1)
Loop
Return TS
End Function
'checks to see if date is within x days of the inputted date
Function isFutureDate(x) As Boolean
Dim daysFuture As Integer
Dim futureDate As Date
daysFuture = Sheet1.Range("e1").Value - 1
'we have to add one to not count today
futureDate = WorksheetFunction.WorkDay(Date, daysFuture)
If x >= Date And x < futureDate Then
isFutureDate = True
Else
isFutureDate = False
End If
End Function
'checks to see if date is in the past x days
Function isPastDate(x) As Boolean
Dim BDate As Date
Dim y As Date
Dim daysPast As Integer
'subtract one to not count today
daysPast = Sheet1.Range("E1").Value - 1 'subtract one to not count today
BDate = WorksheetFunction.WorkDay(Date, -1 * daysPast)
If x < Date And x > BDate Then
isPastDate = True
Else
isPastDate = False
End If
End Function
These are the two functions I have currently. x is passed as a Date. When I step through the program, I notice an error with BDate in the isPastDate function. In my file, I have a cell where the user enters how many days in the future they would like to see entries for. I think this is where my main problem is. When I check the value of daysFuture or daysPast I get 0 while the user entered value is clearly 7.
'checks to see if date is within x days of the inputted date
Function isFutureDate(x As Date) As Boolean
Dim xDays As Integer
Dim xFuture As Integer
xDays = Sheet1.Range("E1").Value
xFuture = DateDiff("d", Date, x)
If xFuture > xDays Then
isFutureDate = True
Else
isFutureDate = False
End If
End Function
'checks to see if date is in the past x days
Function isPastDate(x As Date) As Boolean
Dim xDays As Integer
Dim xPast As Integer
xDays = Sheet1.Range("E1").Value
xPast = DateDiff("d", Date, x)
If xPast < xDays Then
isPastDate = True
Else
isPastDate = False
End If
End Function