I'm solving a problem where in the question is you should get all the list of black fridays from the year 2000 to 2011. So how to do that in vb.net? Any help?
Just wrote this code. Tested in all conditions. Hope it helps. Good Luck :)
Dim BlackFridayList As String = ""
Dim dt As Date
Dim weeknumber As Integer = 1
For i = 2000 To 2011
dt = New Date(i, 11, 1)
weeknumber = 1
' find first friday
While dt.DayOfWeek <> DayOfWeek.Friday
dt = dt.AddDays(1)
weeknumber = weeknumber + 1
End While
If weeknumber = 1 And (dt.Day + 28 < Date.DaysInMonth(dt.Year, dt.Month)) Then
' add four weeks
dt = dt.AddDays(28)
Else
' add three weeks
dt = dt.AddDays(21)
End If
BlackFridayList = BlackFridayList & dt.ToLongDateString & vbCrLf
Next
MsgBox(BlackFridayList) 'List of all black fridays
Black Friday is the day after the fourth Thursday of November. You can determine the dates for those years using DateTime functions.
http://msdn.microsoft.com/en-us/library/system.datetime%28v=vs.110%29.aspx
Function BlackFriday(Year as Integer) As DateTime
Dim november1 = New DateTime(Year, 11, 1)
Dim firstThursday = Enumerable.Range(0, 7).Select(Function(x) november1.AddDays(x)).First(Function(x) x.DayOfWeek = DayOfWeek.Thursday)
Return firstThursday.AddDays(22)
End Function
And to use it:
Dim blackFridays = Enumerable.Range(2000,12).Select(Function(year) BlackFriday(year)).ToList
Related
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
Ok I cannot think of a algorithm to do this using vb.net.
so here is the 3 variable
Dim DateFrom as date = '01/09/2015'
Dim DateNow as date = Date.Now
Dim Holiday() as date '' <-- List of holiday dates
So what I want to do is I want to get the "Day" diffdate From DateFrom and DateNow and excluding the minus the date in the Holiday() array and also saturday Sunday.
so let say my DateFrom is '01/09/2015' which is Tuesday and my
DateNow is '09/09/2015' which is also tuesday and inside the Holiday() array there's '4/09/2015' Friday. the output of diffdate is suppose to be 5 Day since since (DateNow ---Difference Day minus Holiday()array and also minus saturday and sunday -- DateFrom)
I scratches my head about 152.5 times and still cannot find the way to do this.
I think you can solve this problem using something like this:
Dim intTotalDays As Integer = 0
Dim dtStartDate As New DateTime(2015, 10, 1)
Dim dtEndDate As New DateTime(2015, 10, 31)
Dim Holidays As DateTime() = {
New DateTime(2015, 10, 15),
New DateTime(2015, 10, 17)
}
For i As Integer = 0 To DateDiff(DateInterval.Day, dtStartDate, dtEndDate)
Dim dtDay As DateTime = DateAdd(DateInterval.Day, i, dtStartDate)
If Not dtDay.DayOfWeek = DayOfWeek.Saturday And Not dtDay.DayOfWeek = DayOfWeek.Sunday And Not Holidays.Contains(dtDay) Then
intTotalDays += 1
End If
Next i
MsgBox(intTotalDays)
So you want to determine the number of working-days between two dates?
You can use following LINQ query:
Dim DateFrom As Date = #9/1/2015#
Dim Holiday() As Date = {#9/4/2015#}
Dim Weekend() As DayOfWeek = {DayOfWeek.Saturday, DayOfWeek.Sunday}
Dim days As Int32 = (Date.Today - DateFrom).Days + 1 '+ 1 to include end day '
Dim workingDaysBetween =
From d In Enumerable.Range(0, days)
Let day = DateFrom.AddDays(d)
Where Not Weekend.Contains(day.DayOfWeek) AndAlso Not Holiday.Contains(day)
Dim countDays As Int32 = workingDaysBetween.Count()
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
If i have a string containing a date formatted like this:
1402-3
which means Year: 2014, Week: 02 and Day number 3 (monday is 1), how can i convert this to a normal date? (in this case the date above is today; 2014-01-08 - wednesday 8 jan 2014)
Edit: I came up with a function like this, can anyone tell if this is gonna fail or maybe have a better and better coded function/solution?
Private Function StrangeFormattedDateToRegularDate(ByVal StrangeDate As String) As Date
Dim Y As String = "20" & StrangeDate.Substring(0, 2) 'I'll be dead before this fails, haters gonna hate
Dim W As String = StrangeDate.Substring(2, 2)
Dim D As String = StrangeDate.Substring(5, 1)
'Get first day of this year
Dim RefDate As Date = New Date(CInt(Y), 1, 1)
'Get the first day of this week (can be the year before)
Dim daysOffSet As Integer = DayOfWeek.Monday - RefDate.DayOfWeek
RefDate = RefDate.AddDays(daysOffSet)
'Add as many days as the weeks is
RefDate = RefDate.AddDays(7 * CInt(W))
'now the date is the last day of this week (plus one day), remove the days that are ahead, and remove that extra day
Dim daysToRemove = ((7 - CInt(D)) * -1) - 1
RefDate = RefDate.AddDays(daysToRemove)
Return RefDate
End Function
This should be what you're looking for :) This looked challenging so I tried it. Tell me if it works for you or not :)
Function GetDate(InputDate As String) As DateTime
Dim FirstDayofYear As Date = CType("1/1/20" & Mid(InputDate, 1, 2), Date)
Dim LastDayofYear As Date = CType("12/31/20" & Mid(InputDate, 1, 2), Date)
Dim target As Date
For x = 0 To DateDiff(DateInterval.Day, FirstDayofYear, LastDayofYear)
Dim dfi = DateTimeFormatInfo.CurrentInfo
Dim calendar = dfi.Calendar
Dim weekOfyear = calendar.GetWeekOfYear(FirstDayofYear.AddDays(x), dfi.CalendarWeekRule, DayOfWeek.Sunday)
If CInt(Mid(InputDate, 3, 2)) = weekOfyear And CInt(Mid(InputDate, InStr(InputDate, "-") + 1)) = FirstDayofYear.AddDays(x).DayOfWeek Then
target = FirstDayofYear.AddDays(x)
GoTo skip
End If
Next x
skip:
Return target
End Function
This works up to Year 2099. We're probably all dead by then.
I'm trying to count the days between two dates, excluding Saturdays and Sundays. I've written this code so far
Dim startDay As Integer
Dim endDay As Integer
Dim days As Integer
Dim count As Integer
startDay = dtpStartDate.Value.DayOfWeek
endDay = dtpEndDate.Value.DayOfWeek
For days = startDay To endDay
If days = 0 Or days = 6 Then 'Sunday = 0, Saturday = 6
count += 1
End If
Next
lblNoOfDays.Text = count
It works fine if you choose the two dates within the same week. (ex: 23rd Jan to 27th Jan, gives the result 5)
But if I set them to dates in different weeks, (ex : 23rd Jan to 30th Jan, gives the result 1), it gives incorrect results.
I know it happens because of the loop but I can't think of a way to overcome this. Can anyone give me a suggestion, solution??
Thank you
Dim count = 0
Dim totalDays = (dtpEndDate - dtpStartDate).Days
For i = 0 To totalDays
Dim weekday As DayOfWeek = startDate.AddDays(i).DayOfWeek
If weekday <> DayOfWeek.Saturday AndAlso weekday <> DayOfWeek.Sunday Then
count += 1
End If
Next
lblNoOfDays.Text = count
This function calculates the non-weekend days between two dates:
Public Shared Function WorkingDaysElapsed(ByVal pFromDate As Date, ByVal pToDate As Date) As Integer
Dim _elapsedDays As Integer = 0
Dim _weekendDays As DayOfWeek() = {DayOfWeek.Saturday, DayOfWeek.Sunday}
For i = 0 To (pToDate - pFromDate).Days
If Not _weekendDays.Contains(pFromDate.AddDays(i).DayOfWeek) Then _elapsedDays += 1
Next
Return _elapsedDays
End Function