I am a supporter of
St. Joseph's hospice.
 If you find this site useful or if it helped you, consider a small donation to
St. Joseph's, please.

Information on
St. Joseph's

JustGiving - Sponsor me now!

 

Weekday_Dom

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.

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

Sulprobil   Get it done   Contact   Disclaimer   Download