Working on populating a row in excel with dates between a start date and current date. The population is weekly and below is the function I have made. It works fine up until the point where it doesn't stop but continues to go infinitely until there is an overflow error hence my assumption is that CurrentDate is not working properly.
The 2 dates used are StartDate = 04/1/2016 and CurrentDate = 12/07/2017.
Any help or suggestions would be greatly appreciated.
Public Function PopulateStartOfWeekDates()
Dim wsCRC As Worksheet
Set wsCRC = Worksheets("CRC")
Dim StartDate As Date
Dim CurrentDate As Date
StartDate = FirstMondayOfYear()
CurrentDate = Date
Dim WeekOffset As Integer
Dim i As Integer
i = 12
WeekOffset = 0
Debug.Print StartDate
Debug.Print CurrentDate
Do While StartDate < CurrentDate
wsCRC.Cells(5, i) = StartDate + WeekOffset
wsCRC.Cells(5, i).EntireColumn.AutoFit
i = i + 1
WeekOffset = WeekOffset + 7
Loop
End Function
If you decide you need to maintain the value of StartDate (e.g. to use later in the code), you could replace your loop with:
i = 0
Do While StartDate + i * 7 < CurrentDate
wsCRC.Cells(5, i + 12) = StartDate + i * 7
wsCRC.Cells(5, i + 12).EntireColumn.AutoFit
i = i + 1
Loop
After looking at this myself I realized I wasn't increasing the startdate hence the loop was infinite. Thanks to #Nathan_Sav for pointing this out in the comments too.
Related
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 have a MS Access table that has a list of jobs that were executed (Job ID, StartDate, EndDate) I need to find the count of days in a specified date range (e.g. between 1st Jan and 30 Jun) that a user selects using textboxes that have at least 1 job open ie between StartDate and EndDate. I have some experience with VBA and with SQL (not very good with grouping).
Could anyone assist me with a suggestion of how I could get this count?
JobID| StartDate| EndDate
1142| 03-Jan-14| 04-Feb-14|
1143| 13-Mar-14| 18-May-14|
1144| 03-Jan-14| 29-Jan-14|
1145| 20-Jan-14| 13-Apr-14|
1146| 03-Jan-14| 07-Jan-14|
You could create a calendar table as suggested in the comments and add a button called cmdCountJobDays to your form.
The below code will check all possible dates in the selected date range against the job dates. A bit clunky but it will get you there :-)
Private Sub cmdCountJobDays_Click()
Dim StartDate as Date
Dim EndDate as Date
StartDate = me.txtYourStartDateTextBox
EndDate = me.txtYourEndDateTextBox
SQLGetJobCountPeriod = SQLGetJobCountPeriod & "Select CalendarDate from tblCalendarDates where CalendarDate >=" & cdbl(StartDate)
SQLGetJobCountPeriod = SQLGetJobCountPeriod & " and CalendarDate <= " & cdbl(EndDate)
Set dateschecked = CurrentDb.OpenRecordset(SQLGetJobCountPeriod)
If dateschecked.EOF = False Then
dateschecked.MoveFirst
CountOpenJobDays = 0
CountAllDays = 0
Do While dateschecked.EOF = False
CurrentCheckDate = CDbl(dateschecked.Fields("CalendarDate"))
SQLJobDates = "Select StartDate, EndDateDate from jobdetails "
Set Jobdates = CurrentDb.OpenRecordset(SQLJobDates)
If Jobdates.EOF = False Then
Jobdates.MoveFirst
Do While Jobdates.EOF = False
Jobstartdate = CDbl(Jobdates.Fields("StartDate"))
Jobenddate = CDbl(Jobdates.Fields("EndDate"))
If (CurrentCheckDate > Jobstartdate - 1) And (CurrentCheckDate < Jobenddate + 1) Then
CountJobOpen = CountJobOpen + 1
Exit Do
End If
Jobdates.MoveNext
Loop
End If
CountAllDays = CountAllDays + 1
dateschecked.MoveNext
Loop
End If
msgbox CountJobOpen
End Sub
The count is using a datediff function.
datediff(dd,startdate, enddate)
"dd" tells it to find days, start date would be 1/03/2014, and end date would be 2/04/2014 as an example for your first line
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 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
I am trying to figure out how to do this. Been doing research, can't find anything for it that I can figure out how to use.
I have a startdate, enddate, recurringday, customer
startdate = 04/01/2013
enddate = 04/30/2013
customer = john
recurringday = monday
I want to insert a record for john every monday within startdate and enddate, can someone please help me? new to vb.net
Thanks
Use DayofWeek function to check if today's day is monday. Then use Insert command.
Dim startdate As DateTime = Convert.ToDateTime("01 Apr 2013")
Dim enddate As DateTime = Convert.ToDateTime("30 Apr 2013")
Dim DofW = Now.DayOfWeek()
dim recurringday = "Monday"
If now >= startdate And now <= enddate Then
If DofW = recurringday Then
'Insert Record
End If
End If
#Sweety suggested .DayofWeek, but I am not sure his method fulfills your requirements. Try this:
Dim StartDate As DateTime = CDate("01 Apr 2013")
Dim FinishDate As DateTime = CDate("30 Apr 2013")
Dim RecurringDay = "Monday"
Dim Period = FinishDate.Subtract(StartDate).TotalDays
Dim CurrentDate As DateTime
For Counter As Integer = 0 To Period
CurrentDate = StartDate.AddDays(Counter)
If CurrentDate.DayOfWeek = RecurringDay Then
'Insert Record
End If
Next
Try this.
Dim StartDate As DateTime = #4/1/2013#
Dim FinishDate As DateTime = #4/30/2013#
Dim RecurringDay As Integer = DayOfWeek.Monday
'force to first RecurringDay
If RecurringDay < StartDate.DayOfWeek Then StartDate = StartDate.AddDays(7)
StartDate = StartDate.AddDays(RecurringDay - StartDate.DayOfWeek)
Do While StartDate <= FinishDate
Debug.WriteLine(StartDate.ToLongDateString)
'insert record
StartDate = StartDate.AddDays(7)
Loop