Excel Formula -> VBA: Date of each Friday of the current month

1
votes

I have the current formula created by @ScottCraner which when pasted into Cell Q8 and Dragged down to Q12, populates the cells with the date of each friday this month:

Code:

=IFERROR(AGGREGATE(15,6,ROW(INDEX(A:A,EOMONTH(TODAY(),-1)+1):INDEX(A:A,EOMONTH(TODAY(),0)))/(WEEKDAY(ROW(INDEX(A:A,EOMONTH(TODAY(),-1)+1):INDEX(A:A,EOMONTH(TODAY(),0))),1)=6),ROW(1:1)),"-")

Im trying to convert this into VBA as i understand VBA more than formulas. However was wondering if anyone here could possibly help.

It really is appreciated

2
vbaexcelexcel-formula
Rng.Formula = "=IFERROR(AGGREGATE(15,6,ROW(INDEX(A:A,EOMONTH(TODAY(),-1)+1):INDEX(A:A,EOMONTH(TODAY(),0)))/(WEEKDAY(ROW(INDEX(A:A,EOMONTH(TODAY(),-1)+1):INDEX(A:A,EOMONTH(TODAY(),0))),1)=6),ROW(1:1)),""-"")" – Siddharth Rout
The other way would be to loop through dates and then check if it is friday or not – Siddharth Rout
^^^^ Which is exactly what the formula is doing. – Scott Craner
@SiddharthRout So basically you set the range of cells to populate with the formula text instead of having to write it to the cells manually? Makes sense, thank you for your time :) – Batteredburrito
@Jeeped: Ah! I can see you are going to get one now :D. Awesome! It is a nice mug. I have my daily tea in it. – Siddharth Rout

2 Answers

5
votes

This iterates the dates and puts the Fridays in Q8:Q12

Sub myFri()
    Dim OArr(1 To 5, 1 To 1) As Variant
    Dim k As Long
    k = 1
    Dim i As Long
    For i = DateSerial(Year(Date), Month(Date), 1) To DateSerial(Year(Date), Month(Date) + 1, 0)
        If Weekday(i, vbSunday) = 7 Then
            OArr(k, 1) = i
            k = k + 1
        End If
    Next i

    If k = 5 Then OArr(k, 1) = "-"

    Worksheets("Sheet1").Range("Q8:Q12").Value = OArr
    Worksheets("Sheet1").Range("Q8:Q12").NumberFormat = "mm/dd/yyyy"
End Sub
4
votes

Try this quick UDF.

Function listWeekday(dt As Long, ndx As Long, _
                     Optional wd As Long = 6)
    listWeekday = 7 - Weekday(DateSerial(Year(dt), Month(dt), 0), wd) + _
                  DateSerial(Year(dt), Month(dt), 1) + _
                  (ndx - 1) * 7
    If Month(dt) <> Month(listWeekday) Then _
        listWeekday = CVErr(xlErrNA)

End Function

'usage for Fridays in current month
=listWeekday(today(), row(1:1))
'usage for Sundays in current month
=listWeekday(today(), row(1:1), 1)
'usage for Wednesdays in current month
=listWeekday(today(), row(1:1), 4)