Copy Months Between Two Dates on Other Worksheet in VBA

[shellp]

The code below works to get the actual dates of the start and end date as well as all dates in between. I have formulae in columns B, C and D thus the filldown portion of the code.

What I would like is to copy the MONTHS between two periods instead of dates. The start and end dates would be in the format of Apr-2017, May-2017 etc. So if I chose Apr-2017 as start period and Sep-2017 as end period I would want to see, starting in A2, Apr-2017, May-2017, Jun-2017, Jul-2017, Aug-2017 and Sep-2017. All assistance greatly appreciated.

Sub CopyDates()
  
    Dim OutRng As Range
    Dim StartValue As Variant
    Dim EndValue As Variant
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lastrow As Long
        
   Set ws1 = Sheets("Scorecard")
   Set ws2 = Sheets("Data_1")
        
    StartValue = ws1.Range("K1").Value
    EndValue = ws1.Range("K2").Value
    
    ws2.Range("A3:B500").Clear
    Set OutRng = ws2.Range("A2")
    
     If EndValue - StartValue <= 0 Then
        Exit Sub
        End If
        ColIndex = 0
        For i = StartValue To EndValue
            OutRng.Offset(ColIndex, 0) = i
            ColIndex = ColIndex + 1
        Next
        lastrow = ws2.Range("A" & Rows.Count).End(xlUp).Row
        ws2.Range("B2:B" & lastrow).FillDown
    End Sub

 

[Marcelo Branco]

Maybe...

Sub CopyDates()
    Dim OutRng As Range
    Dim StartValue As Variant
    Dim EndValue As Variant
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lastrow As Long
         
    Set ws1 = Sheets("Scorecard")
    Set ws2 = Sheets("Data_1")
         
    StartValue = ws1.Range("K1").Value
    EndValue = ws1.Range("K2").Value
     
    ws2.Range("A3:B500").Clear
    Set OutRng = ws2.Range("A2")
     
    If EndValue - StartValue <= 0 Then Exit Sub
     
    Dim i As Long, NumMonths As Long
    
    NumMonths = DateDiff("m", StartValue, EndValue)
    
    For i = 0 To NumMonths
         OutRng.Offset(i) = DateAdd("m", i, StartValue)
    Next
    OutRng.Resize(NumMonths + 1).NumberFormat = "mmm - yyyy"
    lastrow = ws2.Range("A" & Rows.Count).End(xlUp).Row
    ws2.Range("B2:B" & lastrow).FillDown
End Sub

Hope this helps

M.

 

[shellp]

Thanks Marcelo! It works except in column b the title from B1 copies down, not the formula in B2 so not sure why that is. Also, what if I wanted to make the cells of K1 and K2 drop down lists instead of the user typing in dates? I ask because I did that and now the above doesn't work so I assume I am referencing it wrong. Thanks.

 

[Marcelo Branco]

It worked for me (months in Portuguese: abr = apr; mai = may, etc)

Say you have:

Scorecard
[TABLE="class: grid"]
<tbody>[TR]
[TD="bgcolor: #DCE6F1"][/TD]
[TD="bgcolor: #DCE6F1"]

K
​

[/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]

1​

[/TD]
[TD]

abr-2017
​

[/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]

2
​

[/TD]
[TD]

set-2017
​

[/TD]
[/TR]
</tbody>[/TABLE]


Data_1
[TABLE="class: grid"]
<tbody>[TR]
[TD="bgcolor: #DCE6F1"][/TD]
[TD="bgcolor: #DCE6F1"]

A
​

[/TD]
[TD="bgcolor: #DCE6F1"]

B​

[/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]

1​

[/TD]
[TD]

Header1
​

[/TD]
[TD]

Header2​

[/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]

2​

[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Formula in B2
=IF(A2="","",EOMONTH(A2,0))

Macro

Sub CopyDates()
    Dim OutRng As Range
    Dim StartValue As Variant
    Dim EndValue As Variant
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lastrow As Long
         
    Set ws1 = Sheets("Scorecard")
    Set ws2 = Sheets("Data_1")
         
    StartValue = ws1.Range("K1").Value
    EndValue = ws1.Range("K2").Value
     
    ws2.Range("A3:B500").Clear
    Set OutRng = ws2.Range("A2")
     
    If EndValue - StartValue <= 0 Then Exit Sub
     
    Dim i As Long, NumMonths As Long
    
    NumMonths = DateDiff("m", StartValue, EndValue)
    
    For i = 0 To NumMonths
         OutRng.Offset(i) = DateAdd("m", i, StartValue)
    Next
    OutRng.Resize(NumMonths + 1).NumberFormat = "mmm - yyyy"
    lastrow = ws2.Range("A" & Rows.Count).End(xlUp).Row
    With ws2.Range("B2:B" & lastrow)
        .FillDown
        .NumberFormat = "dd/mm/yyyy"
    End With
End Sub

Data_1 (after the code is run)

[TABLE="class: grid"]
<tbody>[TR]
[TD="bgcolor: #DCE6F1"][/TD]
[TD="bgcolor: #DCE6F1"]

A​

[/TD]
[TD="bgcolor: #DCE6F1"]

B
​

[/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]

1​

[/TD]
[TD]

Header1​

[/TD]
[TD]

Header2​

[/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]

2​

[/TD]
[TD]

abr - 2017​

[/TD]
[TD]

30/04/2017​

[/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]

3​

[/TD]
[TD]

mai - 2017​

[/TD]
[TD]

31/05/2017​

[/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]

4
​

[/TD]
[TD]

jun - 2017​

[/TD]
[TD]

30/06/2017​

[/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]

5
​

[/TD]
[TD]

jul - 2017​

[/TD]
[TD]

31/07/2017​

[/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]

6
​

[/TD]
[TD]

ago - 2017​

[/TD]
[TD]

31/08/2017​

[/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]

7​

[/TD]
[TD]

set - 2017​

[/TD]
[TD]

30/09/2017​

[/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]

8​

[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


M.