List dates based on specific date

[YasserKhalil]

Hello everyone
I have the following udf that returns a 1d array of dates for specific date excluding Friday & Saturday

Code: Select all

Sub Test()
    Dim a
    a = ListDates(Range("A1").Value)
End Sub

Public Function ListDates(ByVal inputDate As Date) As Variant
    Dim outputArray() As Variant, currentDate As Date, i As Long
    ReDim outputArray(1 To 31)
    currentDate = DateSerial(Year(inputDate), Month(inputDate), 1)
    i = 1
    Do While Month(currentDate) = Month(inputDate)
        If Weekday(currentDate) <> vbFriday And Weekday(currentDate) <> vbSaturday Then
            outputArray(i) = currentDate
            i = i + 1
        End If
        currentDate = currentDate + 1
    Loop
    ReDim Preserve outputArray(1 To i - 1)
    ListDates = outputArray
End Function

if A1 was for example 1 Nov 2023, so I got the 1d array starting 1/11/2023 (Wednesday).
What I need is to return the 1d array so as to start with Sunday all the time. so in this case the first item in the output array should be empty.
Also the second item should be empty. Also the third item should be empty. The fourth item should have the first date which is 1/11/2023 (wednesday)

Hope my problem is clear.

[HansV]

What should happen if the input date is Friday the 1st of December 2023?

[HansV]

Does this do what you want?

Code: Select all

Public Function ListDates(ByVal inputDate As Date) As Variant
    Dim outputArray() As Variant, currentDate As Date, i As Long
    Dim startDate As Date
    ReDim outputArray(1 To 31)
    currentDate = DateSerial(Year(inputDate), Month(inputDate), 1)
    startDate = currentDate
    i = 1
    If Weekday(startDate) < 6 Then
        Do Until Weekday(startDate) = 1
            startDate = startDate - 1
            i = i + 1
        Loop
    End If
    Do While Month(currentDate) = Month(inputDate)
        If Weekday(currentDate) <> vbFriday And Weekday(currentDate) <> vbSaturday Then
            outputArray(i) = currentDate
            i = i + 1
        End If
        currentDate = currentDate + 1
    Loop
    ReDim Preserve outputArray(1 To i - 1)
    ListDates = outputArray
End Function

[YasserKhalil]

Amazing. That's exactly what I need.
Thank you so much, my best tutor.

[snb]

Might be a oneliner:

Code: Select all

Sub M_snb()
   sn=Filter([transpose(if((weekday(today()-weekday(today())+row(1:31))<6)*(month(today()-weekday(today())+row(1:31))=month(today())),text(today()-weekday(today())+row(1:31),"yyyy-mm-dd"),"~"))], "~", 0)
    cells(1).resize(ubound(sn)+1)=application.transpose(sn)
End Sub

or, assumed the date format in the cells:

Code: Select all

Sub M_snb()
   MsgBox Join(Filter([transpose(if((weekday(today()-weekday(today())+row(1:31))<6)*(month(today()-weekday(today())+row(1:31))=month(today())),today()-weekday(today())+row(1:31),"~"))], "~", 0))
End Sub

[YasserKhalil]

Great snb
I have tried to populate the dates to column A (formatted in custom way to dd/mm/yyyy)

Code: Select all

Sub Test()
    Dim x
    x = Split(Join(Filter([transpose(if((weekday(today()-weekday(today())+row(1:31))<6)*(month(today()-weekday(today())+row(1:31))=month(today())),text(today()-weekday(today())+row(1:31),"dd-mm-yyyy"),"~"))], "~", 0)))
    Range("A1").Resize(UBound(x) + 1).Value = Application.Transpose(x)
End Sub

But the day and month are reversed. I mean for example 2/7/2023 (should be read as 2dn of July) but it is 7th of Feb.

[snb]

I adapted the code to your needs.