Get First And Last Day Of Year - vba

In VBA I know you can use this syntax to subtract a year from a date
Dim testdate As String, DateTest As String
testdate= "03/21/2017"
DateTest = Month(testdate) & "/" & Day(testdate) & "/" & Year(testdate) - 1
But how could you find the first and last date of a given year? For example, let's use the same date
testdate = "03/21/2017"
and get the following values
firstdate = "01/01/2017"
lastdate = "12/31/2017"

You can use DateSerial:
Sub Test()
Dim dt As Date, firstDay As Date, lastDay As Date
dt = Date
firstDay = DateSerial(Year(dt), 1, 1)
lastDay = DateSerial(Year(dt), 12, 31)
Debug.Print firstDay
Debug.Print lastDay
End Sub

If it is always the beginning and the end of the year that interest you, you can just use the 1st of January and the 31st of december. To mimic your syntax :
Dim testdate As String, DateTest As String
testdate= "03/21/2017"
FirstDayOfYear = "1/1/" & Year(testdate)
LastDayOfYear = "12/31/" & Year(testdate)

Related

How to count someday to someday without holiday and Saturday , Sunday (VB) by use Date time picker

enter image description hereHow to count someday to someday without holiday and Saturday , Sunday (VB) by use Date time picker
for leave people system
help me please!
from the picture
left is date start and right is end date
then if I select date both. then count day on the textbox... without Sunday Saturday and Holiday that on Access database...
Count days from start to finish that are not Saturday or Sunday:
Dim startDate As Date = New DateTime(2016, 1, 1)
Dim endDate As Date = DateTime.Now
Dim currentDate = startDate
Dim daysWithoutSatOrSun As Integer = 0
Do
If currentDate.DayOfWeek <> DayOfWeek.Saturday AndAlso currentDate.DayOfWeek <> DayOfWeek.Sunday Then
daysWithoutSatOrSun += 1
End If
currentDate = currentDate.AddDays(1)
Loop Until currentDate > endDate
MessageBox.Show("Days " & daysWithoutSatOrSun)
One readable option is to use LINQ:
Dim days As Int32 = (d2 - d1).Days
Dim weekend = {DayOfWeek.Saturday, DayOfWeek.Sunday }
Dim nonWeekendDays = From d in Enumerable.Range(0, days + 1)
Select day = d1.Date.AddDays(d)
Where Not weekend.Contains(day.DayOfWeek)
Dim countOfDays As Int32 = nonWeekendDays.Count()
If you have List(Of Date) which contains the holidays you can add:
Where Not weekend.Contains(day.DayOfWeek) AndAlso Not holidays.Contains(day)

VB.NET - Given a date, how can I get the date of last four fridays?

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

VBA change specific bit of date

I currently have a spreadsheet with pre written dates in order in a dd/mm/yyyy format, but i want to be able to change the entire sheet so that when i select a month from a drop down list it changes all the dates so they stay starting at the 1st through to the 31st, but only the month changes, using visual basic. I can use this to set specific dates,
Range("C3") = Format(DateSerial(Year:=2005, Month:=2, Day:=3), "mm-dd-yyyy")
But can i change just the month using something like this for example
Range("C3") = Format(DateSerial(Month:=5), "mm-dd-yyyy")
You could do something like this:
Function MakeDates(startDate As Date) As Date()
Dim myDates() As Date, myYear As Integer, myMonth As Integer, daysInMonth As Integer
Dim firstOfMonth As Date, firstOfNextMonth As Date, d As Integer
myYear = Year(startDate)
myMonth = Month(startDate)
firstOfMonth = DateSerial(myYear, myMonth, 1)
firstOfNextMonth = DateSerial(myYear, myMonth + 1, 1)
daysInMonth = DateDiff("d", firstOfMonth, firstOfNextMonth)
ReDim myDates(daysInMonth - 1)
For d = 1 To daysInMonth
myDates(d - 1) = DateSerial(myYear, myMonth, d)
Next d
MakeDates = myDates
End Function
Then you can call it like this
Dim d
d = MakeDates(#2/1/2014#)
Range("A1").Resize(rowsize:=31).Value = ""
Range("A1").Resize(rowsize:=UBound(d) + 1) = WorksheetFunction.Transpose(d)
That second to last line will remove the excess dates for you.
You should have your range formatted as a date. You can do that in code or just do it once in Excel. The latter is probably easier.

Special date formatted string to Date (VB.net)

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.

Getting Dates of Current week does not work as expected

iam trying to get the Dates (Monday - Sunday) for the current Week.
This is my current Code:
Dim kw As Integer = DatePart(DateInterval.WeekOfYear, Now, , FirstWeekOfYear.FirstFourDays)
If DatePart(DateInterval.Weekday, Now, Microsoft.VisualBasic.FirstDayOfWeek.Sunday) = 6 Then
kw = kw + 1
End If
Dim CurrDateFirstDay As Date = DateAdd(DateInterval.Day, 1, ReturnDateForWeekNumber(kw))
For i = 1 To 7
strCurrDay = FormatDateTime(CurrDateFirstDay, DateFormat.LongDate)
........
My Problem is that my code starts at 16.01.2013 and the last date is Thuesday 22.01.2013 next week. Why is that? Why does he start Wednesday 16.01.2013 and not Monday 14.01.2013? And why do i get returned dates of the next week? What iam doing wrong?
Edit:
ReturnDateForWeekNumber:
Public Shared Function ReturnDateForWeekNumber(ByVal iWeek As Integer) As DateTime
Return DateAdd(DateInterval.WeekOfYear, iWeek - 1, FirstDayOfYear)
End Function
What am I doing wrong?
You should step through your code in the debugger and observe the result, as I did:
Dim kw As Integer = DatePart(DateInterval.WeekOfYear, Now, , FirstWeekOfYear.FirstFourDays)
This returns the current week, which is week 3.
If DatePart(DateInterval.Weekday, Now, Microsoft.VisualBasic.FirstDayOfWeek.Sunday) = 6 Then
kw = kw + 1
End If
This checks if the weekday is the 6th day of the week (friday). We're not friday so If condition is not entered.
Dim CurrDateFirstDay As Date = DateAdd(DateInterval.Day, 1, ReturnDateForWeekNumber(kw))
This adds one day to the result of ReturnDateForWeekNumber, which returns:
Return DateAdd(DateInterval.WeekOfYear, iWeek - 1, FirstDayOfYear)
This adds 2 (week 3 minus 1) weeks to the first day of the year (Jan 1st), a tuesday. Jan 1st + 2 weeks = January 15th.
Now remember that you add one day to ReturnDateForWeekNumber, that's why CurrDateFirstDay has a value of January 16th.
Edit
I think your code is overly complicated and uses a lot of legacy VB6 functions. I would do it this way:
Dim myDate As Date = DateTime.Today
Dim dayDiff As Integer = myDate.DayOfWeek - DayOfWeek.Monday
Dim currentDay As Date = myDate.AddDays(-dayDiff) 'Monday
For i = 1 to 7
Console.WriteLine(currentDay)
'Do something with current day
currentDay = currentDay.AddDays(1)
Next
You might have to do some adjustments for your case but I believe this approach is simpler and less error prone.
Dim dateStartDateOfWeek As Date = GetWeekStartDate(52, 2014)
Dim dateEndDateOfWeek As Date = DateAdd(DateInterval.Day, 7, dateStartDateOfWeek)
Private Function GetWeekStartDate(ByVal weekNumber As Integer, ByVal year As Integer) As Date
Dim startDate As New DateTime(year, 1, 1)
Dim weekDate As DateTime = DateAdd(DateInterval.WeekOfYear, weekNumber - 1, startDate)
Return DateAdd(DateInterval.Day, (-weekDate.DayOfWeek) + 1, weekDate)
End Function