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

Assuming A2 & B2 are already dates,

Sub CreateReport()
Dim mth as Date, endmth as Date, orow as Integer

mth = worksheetfunction.eomonth(activesheet.cells(2,1).value,0)
endmth = worksheetfunction.eomonth(activesheet.cells(2,2).value,0)
orow = 5
Do
    Activesheet.cells(orow,1).value = worksheetfunction.min(activesheet.cells(2,2).value,mth)
'    Activesheet.cells(orow,1).numberformat = "mmm"  'uncomment for automatic formatting 
    orow = orow + 1
    mth = worksheetfunction.eomonth(mth,1)
Loop While mth <= endmth
End Sub

This actually puts dates into your output column which can custom format as "mmm" if necessary. If you decide you actually just want text in those columns then just wrap the min(endmth,mth) in a worksheetfunction.text function with a "mmm" format.

Answer 2

As replay to @T.M. nice piece of code. The version using Row Evaluation:

Function GetCampaignMnths(StartDate As Date, StopDate As Date)
'Purpose: get vertical 2-dim array of month names
'b) get rows numbers representing months
    Dim monthsNo As Long, rows As String
    monthsNo = DateDiff("m", StartDate, StopDate, vbMonday)
    rows = Month(StartDate) & ":" & monthsNo + Month(StartDate)
'c) evaluate dates
    Dim months
    months = Evaluate("Text(Date(0,row(" & rows & "),1),""mmmm"")")
    GetCampaignMnths = months
End Function

It can be easily tested using the next sub:

Sub testGetCampaignMohths()
   Dim arr
   arr = GetCampaignMnths("01.03.2021", "01.08.2022") 'use here date recognized by yor localization. Or build them using DateSerial
   Debug.Print Join(Application.Transpose(arr), "|")
End Sub

Answer 3

You can also do this with functions, no VBA required:

Office 365

A5: =EOMONTH(Campaign_Start,SEQUENCE(1+DATEDIF(Campaign_Start,Campaign_End,"m")+(DAY(Campaign_End)<DAY(Campaign_Start)),,0))

and the results will SPILL down as far as needed.

Format the cells as mmm

If you do not have Office 365, then try:

=EOMONTH(Campaign_Start,-1+ROW(INDEX($A:$A,1):INDEX($A:$A,1+DATEDIF(Campaign_Start,Campaign_End,"m")+(DAY(Campaign_End)<DAY(Campaign_Start)))))

If your version of Excel does not have dynamic arrays where the results SPILL, you will need to enter the formula in the individual cells as an array, and it would require further modification.

Answer 4

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 5

If you would rather avoid VBA entirely, Excel's array functions let you do this using spreadsheet formulae (if your version of Excel is recent enough).

Put this formula in Cell A5 (assuming start date in A2, and end date in B2):

=LET(mnths,1+(12*YEAR(B2)+MONTH(B2)-(12*YEAR(A2)+MONTH(A2))),s,SEQUENCE(mnths),TEXT(DATE(YEAR(A2),MONTH(A2)+(s-1),1),"mmm"))

If you have more than a year, you can amend the TEXT format string to "mmm-yy".

Answer 6

Please, try the next code:

Sub GenerateMonthsL()
   Dim sh As Worksheet, firstM As Long, lastM As Long, arrD, arrProj, i As Long, k As Long
   
   Set sh = ActiveSheet

   firstM = month(sh.Range("A2").Value2)
   lastM = month(sh.Range("B2").Value2)
   arrD = Split("Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Dec", ",")
   ReDim arrProj(lastM - firstM + 1)
   For i = firstM - 1 To lastM - 1
        arrProj(k) = arrD(i): k = k + 1
   Next
   ReDim Preserve arrProj(k - 1)
   sh.Range("A5").Resize(UBound(arrProj) + 1, 1).value = Application.Transpose(arrProj)
   With sh.Range("A4:B4")
        .value = Array("Months", "Articles Published")
        .Font.Bold = True
        .Interior.Color = 14998742
        .EntireColumn.AutoFit
   End With
End Sub

Answer 7

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