Help Converting Formula to VBA: Fill cell range with date of Fridays this month

[Batteredburrito]

Hi, I have the current formula 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)),"-")</code>

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

 

[JustynaMK]

Hi,

Try to use the following code:

Option Explicit


Sub Fridays()
    Dim lngMonth            As Long
    Dim lngYear             As Long
    Dim lngWeekday          As Long
    Dim lngDate             As Long
    Dim i                   As Integer
    
    'Today's date values:
[COLOR=#ff0000]    lngDate = DateSerial(2018, 7, 1)[/COLOR]
    lngMonth = Month(lngDate)
    lngYear = Year(lngDate)
    lngWeekday = WorksheetFunction.Weekday(DateSerial(lngYear, lngMonth, 1), 2)
    
    With Sheet1
        'Return the first Friday of the current month
        If lngWeekday <= 5 Then
                .Range("B3").Value = DateSerial(lngYear, lngMonth, 1 + (5 - lngWeekday))
            Else
                .Range("B3").Value = DateSerial(lngYear, lngMonth, 1 + 12 - lngWeekday)
        End If
        
        'Return the remaining dates
        For i = 1 To 5
            If Month(.Range("B3").Value + i * 7) = lngMonth Then
                .Range("B" & i + 3).Value = .Range("B3").Value + i * 7
            Else
                Exit Sub
            End If
        Next i
        
    End With


End Sub

It will return all Friday dates for a given month in Sheet1, cell range B3:B8. You can use the highlighted line to change the date values (year-month-day, although day is always ignored), or simply replace it with:
lngDate = Date
...to always use today's date.

I hope it helps.

Best regards,
Justyna