Sulprobil
Search…
Weekday Day of Month
If you like to list all Friday 13th between let's say 1-Mar-1900 and 5-Jun-2079 then you have several options. First enter start date into B1, end date into B2, weekday 6 (Friday) into B3 and day of month 13 into B4. Now you can:
a) Use worksheet functions:
a1) [Not recommended - too slow] Define name b: =ROW(INDIRECT(B1&":"&B2)) Define name s: =ROW(1:310) Now select 310 adjacent cells in a column and enter as array formula =LARGE(b*(WEEKDAY(b)=B3)*(DAY(b)=B4),s)
a2) [Not recommended - too slow] Define name d: =ROW(1:65536) Define name s: =ROW(1:310) Now select 310 adjacent cells in a column and enter as array formula =LARGE(d*(B1<=d)*(B2>=d)*(WEEKDAY(d)=B3)*(DAY(d)=B4),s)
b) [Recommended - not too fast but ok] Use a user-defined function: Select 310 adjacent cells in a column and enter as array formula =TRANSPOSE(weekday_dom(B1,B2,B3,B4)) Put macro text shown below into a macro module.
Please read my Disclaimer.
Function weekday_dom(dtstart As Date, _
dtend As Date, _
lwd As Long, _
ldom As Long) As Date()
'Lists all days of all months between dtstart
'and dtend which are weekday lwd and day of
'month ldom.
'lwd: 1=Sunday, ... 7=Saturday
'Reverse(moc.liborplus.www) V0.3
Dim dt As Date, i As Long, j As Long
Dim ly As Long, lm As Long
ReDim dtR(1 To 309) As Date
If dtstart < #1/30/1900# Then
'Excel has a problem with 29/2/1900
weekday_dom = CVErr(xlErrNum)
Exit Function
End If
If Day(dtstart) > ldom Then
i = 1
Else
i = 0
End If
j = 1
ly = Year(dtstart)
lm = Month(dtstart)
dt = DateSerial(ly, lm + i, ldom)
Do While dt <= dtend
dt = DateSerial(ly, lm + i, ldom)
If Weekday(dt) = lwd And Day(dt) = ldom Then
dtR(j) = dt
j = j + 1
End If
i = i + 1
Loop
ReDim Preserve dtR(1 To j - 1) As Date
weekday_dom = dtR
End Function
c) [If you really need a fast solution - but try to split the huge worksheet formula over several cells] Use a precalculated array with worksheet functions: Create a worksheet with name P, run VBA macro shown below, select 310 adjacent cells in a column and enter as array formula =IF(IF(ISERROR(MATCH($B$1,INDEX(P!$A$3:$HI$311,1,($B$4-1)7+$B$3):INDEX(P!$A$3:$HI$311,309,($B$4-1)7+$B$3),1)),0,MATCH($B$1,INDEX(P!$A$3:$HI$311,1,($B$4-1)7+$B$3):INDEX(P!$A$3:$HI$311,309,($B$4-1)7+$B$3),1))+ISERROR(MATCH($B$1,INDEX(P!$A$3:$HI$311,1,($B$4-1)7+$B$3):INDEX(P!$A$3:$HI$311,309,($B$4-1)7+$B$3),0))>MATCH($B$2,INDEX(P!$A$3:$HI$311,1,($B$4-1)7+$B$3):INDEX(P!$A$3:$HI$311,309,($B$4-1)7+$B$3),1),1/0,INDEX(P!$A$3:$HI$311,IF(ISERROR(MATCH($B$1,INDEX(P!$A$3:$HI$311,1,($B$4-1)7+$B$3):INDEX(P!$A$3:$HI$311,309,($B$4-1)7+$B$3),1)),0,MATCH($B$1,INDEX(P!$A$3:$HI$311,1,($B$4-1)7+$B$3):INDEX(P!$A$3:$HI$311,309,($B$4-1)7+$B$3),1))+ISERROR(MATCH($B$1,INDEX(P!$A$3:$HI$311,1,($B$4-1)7+$B$3):INDEX(P!$A$3:$HI$311,309,($B$4-1)7+$B$3),0)),($B$4-1)7+$B$3):INDEX(P!$A$3:$HI$311,MATCH($B$2,INDEX(P!$A$3:$HI$311,1,($B$4-1)7+$B$3):INDEX(P!$A$3:$HI$311,309,($B$4-1)7+$B$3),1),($B$4-1)7+$B$3))
Sub populate_p_wkd()
'Populate sheet P with weekdays & days of months
'Reverse(moc.liborplus.www) V0.1
Dim i As Long, j As Long, k As Long, m As Long
Dim d As Long, w As Long
Dim wkd(1 To 217) As Long
Sheets("P").Select
Range("A1:HI311").ClearContents
For i = 1 To 31
For j = 1 To 7
k = (i - 1) * 7 + j 'day
Cells(2, k) = i 'day of month
Cells(1, k) = j 'weekday
Next j
Next i
For i = 61 To 65536
w = Weekday(CDate(i))
d = Day(CDate(i))
k = (d - 1) * 7 + w
wkd(k) = wkd(k) + 1
Cells(wkd(k) + 2, k) = CDate(i)
Next i
End Sub
Copy link