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.
1
Function weekday_dom(dtstart As Date, _
2
dtend As Date, _
3
lwd As Long, _
4
ldom As Long) As Date()
5
'Lists all days of all months between dtstart
6
'and dtend which are weekday lwd and day of
7
'month ldom.
8
'lwd: 1=Sunday, ... 7=Saturday
9
'Reverse(moc.liborplus.www) V0.3
10
Dim dt As Date, i As Long, j As Long
11
Dim ly As Long, lm As Long
12
ReDim dtR(1 To 309) As Date
13
14
If dtstart < #1/30/1900# Then
15
'Excel has a problem with 29/2/1900
16
weekday_dom = CVErr(xlErrNum)
17
Exit Function
18
End If
19
20
If Day(dtstart) > ldom Then
21
i = 1
22
Else
23
i = 0
24
End If
25
j = 1
26
ly = Year(dtstart)
27
lm = Month(dtstart)
28
dt = DateSerial(ly, lm + i, ldom)
29
Do While dt <= dtend
30
dt = DateSerial(ly, lm + i, ldom)
31
If Weekday(dt) = lwd And Day(dt) = ldom Then
32
dtR(j) = dt
33
j = j + 1
34
End If
35
i = i + 1
36
Loop
37
ReDim Preserve dtR(1 To j - 1) As Date
38
weekday_dom = dtR
39
End Function
Copied!
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))
1
Sub populate_p_wkd()
2
'Populate sheet P with weekdays & days of months
3
'Reverse(moc.liborplus.www) V0.1
4
5
Dim i As Long, j As Long, k As Long, m As Long
6
Dim d As Long, w As Long
7
Dim wkd(1 To 217) As Long
8
9
Sheets("P").Select
10
Range("A1:HI311").ClearContents
11
For i = 1 To 31
12
For j = 1 To 7
13
k = (i - 1) * 7 + j 'day
14
Cells(2, k) = i 'day of month
15
Cells(1, k) = j 'weekday
16
Next j
17
Next i
18
19
For i = 61 To 65536
20
w = Weekday(CDate(i))
21
d = Day(CDate(i))
22
k = (d - 1) * 7 + w
23
wkd(k) = wkd(k) + 1
24
Cells(wkd(k) + 2, k) = CDate(i)
25
Next i
26
27
End Sub
Copied!
Last modified 1yr ago
Copy link