Excel: Display collection of month names generated from start and end date?

Question

I am trying to generate a table to record articles published each month. However, the months I work with different clients vary based on the campaign length. For example, Client A is on a six month contract from March to September. Client B is on a 12 month contract starting from February.

Rather than creating a bespoke list of the relevant months each time, I want to automatically generate the list based on campaign start and finish.

Here's a screenshot to illustrate how this might look:

Below is an example of expected output from the above, what I would like to achieve:

Currently, the only month that's generated is the last one. And it goes into A6 (I would have hoped A5, but I feel like I'm trying to speak a language using Google Translate, so...).

Here's the code I'm using:

Sub CreateReport()
    Dim uniqueMonths As Collection
    Set uniqueMonths = New Collection

    Dim dateRange As Range
    Set dateRange = Range("B2:C2")

On Error Resume Next

    Dim currentRange As Range
    For Each currentRange In dateRange.Cells

If currentRange.Value <> "" Then

    Dim tempDate As Date: tempDate = CDate(currentRange.Text)
    Dim parsedDateString As String: parsedDateString = Format(tempDate, "MMM")
    uniqueMonths.Add item:=parsedDateString, Key:=parsedDateString

End If

Next currentRange

On Error GoTo 0

    Dim uniqueMonth As Variant
    For Each uniqueMonth In uniqueMonths

Debug.Print uniqueMonth

Next uniqueMonth

    Dim item As Variant, currentRow As Long
    currentRow = 5
    For Each item In uniqueMonths
    dateRange.Cells(currentRow, 0).Value = item
    currentRow = currentRow + 1
Next item

End Sub

Answer 1

User defined function via Evaluate

Simply enter =GetCampaignMonths(A2,B2) into cell A5.

If you don't dispose of the newer dynamic versions 2019+/MS365, it's necessary to enter a CSE (Ctrl+Shift+Enter) to finish an {array formula}:

Explanation

Basically this displays all results as dynamic (spill) range, profiting from an evaluation of a code one liner ...

e.g. Jan..Dec (12 months represented by column addresses)*

=TEXT(DATE(0,Column(A:L),1),"mmmm")

If you want to include further years, the udf simply adds the years difference (section a) multiplied by 12 to the column numbers (c.f. section b).

The evaluation of the DATE() function (c.f. section c) gets even successive years correctly, TEXT() returns the (English) months names formatted via "mmmm".

Public Function GetCampaignMonths(StartDate As Date, StopDate As Date)
'Purpose: get vertical 2-dim array of month names
'a) get years difference
    Dim yrs As Long: yrs = Year(StopDate) - Year(StartDate)
'b) get column numbers representing months
    Dim cols As String
    cols = Split(Cells(, month(StartDate)).Address, "$")(1)
    cols = cols & ":" & Split(Cells(, month(StopDate) + Abs(yrs * 12)).Address, "$")(1)
'c) evaluate dates
    Dim months
    months = Evaluate("Text(Date(0,Column(" & cols & "),1),""mmmm"")")
    GetCampaignMonths = Application.Transpose(months)
End Function

Answer 2

Make an Array with the month names and then loop trough it accordting to initial month and end month:

Sub test()
Dim IniDate As Date
Dim EndDate As Date
Dim Months As Variant
Dim i As Long
Dim zz As Long

IniDate = CDate(Range("A2").Value)
EndDate = CDate(Range("b2").Value)

Months = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")

zz = 5
For i = Month(IniDate) - 1 To Month(EndDate) - 1 Step 1
    Range("A" & zz) = Months(i)
    zz = zz + 1
Next i

Erase Months

End Sub

For this code to work, both dates must be recognized as dates properly. Make sure of that or it won't work.

IMPORTANT: This will work only with dates in same year, unfortunately... I noticed that right now.

UPDATE: You can benefit from DateAdd and DateDiff to make a code so it works even in different years :)

DateAdd function

DateDiff Function

Sub test2()
Dim IniDate As Date
Dim EndDate As Date
Dim Months As Variant
Dim i As Long
Dim zz As Long
Dim TotalMonths As Byte

IniDate = CDate(Range("A2").Value)
EndDate = CDate(Range("b2").Value)

Months = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")

TotalMonths = DateDiff("m", IniDate, EndDate, vbMonday)


zz = 5
For i = 0 To TotalMonths Step 1
    Range("A" & zz).Value = Months(Month(DateAdd("m", i, IniDate)) - 1)
    zz = zz + 1
Next i

Erase Months


End Sub