PDA

View Full Version : Get first and last dates (dd/mm/jj) from year range



nikki333
11-18-2019, 12:02 PM
Hi Folks

This seems to be pretty straight forward, but my brain doesn't do anymore.

So if the user wants to plan for 2020, i'd like the date range to start from first week 2019 (i.e. starting from monday that is 31.12.18) and the last week of 2021 (i.e. 31.12.21) and then fill up the dates in between.

It sounds easy, but turns out as a nightmare.

any ideas?

Paul_Hossler
11-18-2019, 01:38 PM
I've seen more complicated ways to do it, but I prefer the more straight-forward way below




Option Explicit


Sub ThreeYears()
Dim dateStart As Date, dateEnd As Date
Dim i As Long, o As Long


dateStart = DateSerial(Year(Now), 1, 0)
Do While Weekday(dateStart) <> vbMonday
dateStart = dateStart - 1
Loop


dateEnd = DateSerial(Year(Now) + 3, 1, 0)
' MsgBox dateStart & " -- " & dateEnd


o = 0
For i = dateStart To dateEnd
ActiveSheet.Cells(o + 1, 1).Value = dateStart + o
o = o + 1
Next i


End Sub

snb
11-18-2019, 04:57 PM
Sub M_snb()
sn = [index(date(2019,1,4)-weekday(date(2019,1,4),2)+row(offset(A1,,,date(2021,1,4)-weekday(date(2021,1,4),2)-3-(date(2019,1,4)-weekday(date(2019,1,4),2)))),)]
sheet1.cells(1).resize(Ubound(sn))=application.transpose(sn)
End Sub

Paul_Hossler
11-19-2019, 07:08 AM
Sub M_snb()
sn = [index(date(2019,1,4)-weekday(date(2019,1,4),2)+row(offset(A1,,,date(2021,1,4)-weekday(date(2021,1,4),2)-3-(date(2019,1,4)-weekday(date(2019,1,4),2)))),)]
sheet1.cells(1).resize(Ubound(sn))=application.transpose(sn)
End Sub

For some reason, all I get in A1:A732 is 43465, which if I format it is 12/31/2018

snb
11-19-2019, 07:25 AM
Well it proves that VBA is very consistent.

You'd better use:


Sub M_snb()
sn = [index(date(2019,1,4)-weekday(date(2019,1,4),2)+row(offset(A1,,,date(2021,1,4)-weekday(date(2021,1,4),2)-3-(date(2019,1,4)-weekday(date(2019,1,4),2)))),)]
Sheet1.Cells(1).Resize(UBound(sn)) = sn
End Sub

Alternative:


Sub M_snb()
x = DateSerial(2019, 1, 4)
y = DateSerial(2021, 1, 4)

Cells(1, 4) = x - Weekday(x, 2) + 1
Cells(1, 4).AutoFill Cells(1, 4).Resize(y - Weekday(y, 2) - 2 - Cells(1, 4))
End Sub