Repeat Values and Range of Dates Based on Cell Values

[TheJonWithNoH]

Good Evening,

In one "master sheet" in cell "A1" I have the date 1/1/2020. This cell / date controls many other formulas in my workbook. In cell "B2" of another sheet I have a formula that equals cell "A1" in my master sheet. I need cells "B3" and below to proceed with 1/2/2020, 1/3/2020, etc but once the month is over I need it to start back at 1/1/2020 and repeat 4 times. After every day in the month has repeated 4 times I need the next month to start.

Also, in this same sheet in column A i have 4 values that I need to repeat every day. I have these values listed in cells AB2:AB5. I also have a list of months in cells AC2:AC13 and formula to count the number of days in these months in AD2:AC13. Here's an example:

[TABLE="width: 500"]
<tbody>[TR]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[/TR]
[TR]
[TD]Apples[/TD]
[TD]1/1/2020[/TD]
[/TR]
[TR]
[TD]Apples[/TD]
[TD]1/2/2020[/TD]
[/TR]
[TR]
[TD]Apples[/TD]
[TD]1/3/2020[/TD]
[/TR]
[TR]
[TD]Apples[/TD]
[TD]1/4/2020[/TD]
[/TR]
[TR]
[TD]Apples[/TD]
[TD]1/5/2020[/TD]
[/TR]
[TR]
[TD]...... [/TD]
[TD]....... All the way down to the end of the month[/TD]
[/TR]
[TR]
[TD]Apples[/TD]
[TD]1/31/2020[/TD]
[/TR]
[TR]
[TD]Oranges[/TD]
[TD]1/1/2020[/TD]
[/TR]
[TR]
[TD]Oranges[/TD]
[TD]1/2/2020[/TD]
[/TR]
[TR]
[TD]Oranges[/TD]
[TD]1/3/2020[/TD]
[/TR]
[TR]
[TD].....[/TD]
[TD]..... All the way down to the end of the month[/TD]
[/TR]
[TR]
[TD]Oranges[/TD]
[TD]1/31/2020[/TD]
[/TR]
[TR]
[TD]Bananas[/TD]
[TD]1/1/2020[/TD]
[/TR]
[TR]
[TD]......[/TD]
[TD].... All the way down to the end of the month[/TD]
[/TR]
[TR]
[TD]Bananas[/TD]
[TD]1/31/2020[/TD]
[/TR]
[TR]
[TD]Apples[/TD]
[TD]2/1/2020 (start over with apples for new month)[/TD]
[/TR]
[TR]
[TD]Apples[/TD]
[TD]2/2/2020[/TD]
[/TR]
</tbody>[/TABLE]

I'm not to great at explaining these but hopefully someone will understand and be able to help me out.

Thanks in advance!

JB

 

[Trebor76]

Hi Jon,

Try this (note my comments as well):

Option Explicit
Sub Macro1()
    
    Dim wsSourceTab As Worksheet
    Dim wsOutputTab As Worksheet
    Dim bteNumOfDays As Byte
    Dim rngMyCell As Range
    
    Set wsSourceTab = Sheets("master sheet")
    Set wsOutputTab = Sheets("Sheet2") 'Change to suit
    
    'Assumes the months in AC2 to AC13 of the wsOutputTab tab are text
    'and are in abbreviated form i.e. "Jan", "Feb", "Mar"..."Dec"
    'Change to suit
    On Error Resume Next
        bteNumOfDays = Evaluate("VLOOKUP(""" & Format(wsSourceTab.Range("A1"), "mmm") & """," & wsOutputTab.Name & "!AC:AD,2,FALSE)")
        If bteNumOfDays = 0 Then
            MsgBox "There was an error trying to assign the number of days for the month." & vbNewLine & "Please check and try again.", vbExclamation
            Exit Sub
        End If
    On Error GoTo 0
    
    Application.ScreenUpdating = False
    
    For Each rngMyCell In wsOutputTab.Range("AB2:AB" & wsOutputTab.Range("AB" & Rows.Count).End(xlUp).Row)
        wsOutputTab.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Resize(bteNumOfDays, 1).Value = rngMyCell.Value
    Next rngMyCell
    
    Application.ScreenUpdating = True
    
    MsgBox "Data has now been copied.", vbInformation

End Sub

Regards,

Robert

 

[Trebor76]

Just noticed I forgot the dates!!

Try this instead:

Option Explicit
Sub Macro1()
    
    Dim wsSourceTab As Worksheet
    Dim wsOutputTab As Worksheet
    Dim bteNumOfDays As Byte
    Dim rngMyCell As Range
    Dim blnFirstText As Boolean
    Dim i As Byte
    
    Set wsSourceTab = Sheets("master sheet")
    Set wsOutputTab = Sheets("Sheet2") 'Change to suit
    
    'Assumes the months in AC2 to AC13 of the wsOutputTab tab are text
    'and are in abbreviated form i.e. "Jan", "Feb", "Mar"..."Dec"
    'Change to suit
    On Error Resume Next
        bteNumOfDays = Evaluate("VLOOKUP(""" & Format(wsSourceTab.Range("A1"), "mmm") & """," & wsOutputTab.Name & "!AC:AD,2,FALSE)")
        If bteNumOfDays = 0 Then
            MsgBox "There was an error trying to assign the number of days for the month." & vbNewLine & "Please check and try again.", vbExclamation
            Exit Sub
        End If
    On Error GoTo 0
    
    Application.ScreenUpdating = False
    
    blnFirstText = True
    
    For Each rngMyCell In wsOutputTab.Range("AB2:AB" & wsOutputTab.Range("AB" & Rows.Count).End(xlUp).Row)
        For i = 1 To bteNumOfDays
            If blnFirstText = True Then
                wsOutputTab.Cells(3, "A") = wsSourceTab.Range("A1") + i - 1
                wsOutputTab.Cells(3, "B") = rngMyCell.Value
                blnFirstText = False
            Else
                wsOutputTab.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = wsSourceTab.Range("A1") + i - 1
                wsOutputTab.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0) = rngMyCell.Value
            End If
        Next i
    Next rngMyCell
    
    Application.ScreenUpdating = True
    
    MsgBox "Data has now been copied.", vbInformation

End Sub

Robert

 

[TheJonWithNoH]

Thanks Robert... My months are not in text though, they are in date format, but custom to be in the abbreviated form ("mmm"). January ("Jan") actually feeds from the source tab "A1" and the following months are a formula (February =(EOMONTH(AC2,0))+1) and so on and so forth. There is also a formula to calculate the number of days in the month in column AD.

How can I modify your VBA code to achieve what I am wanting to do?

Thank you so much!

 

[Trebor76]

Try this:

Option Explicit
Sub Macro1_CopyText_n_Dates()
    
    Dim wsSourceTab As Worksheet
    Dim wsOutputTab As Worksheet
    Dim bteNumOfDays As Byte
    Dim rngMyCell As Range
    Dim blnFirstText As Boolean
    Dim i As Byte
    
    Set wsSourceTab = Sheets("master sheet")
    Set wsOutputTab = Sheets("Sheet2") 'Change to suit
    
    'Assign number of days based on month entered in cell A1 of 'wsSourceTab'
    'to the list in cells AC2:AC13 of 'wsOutputTab'
    For Each rngMyCell In wsOutputTab.Range("AC2:AC13")
        If MonthName(Month(rngMyCell), True) = MonthName(Month(wsSourceTab.Range("A1")), True) Then
           bteNumOfDays = rngMyCell.Offset(0, 1)
           Exit For
        End If
    Next rngMyCell
    If bteNumOfDays = 0 Then
        MsgBox "There was an error trying to assign the number of days for the month." & vbNewLine & "Please check and try again.", vbExclamation
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    blnFirstText = True
    
    For Each rngMyCell In wsOutputTab.Range("AB2:AB" & wsOutputTab.Range("AB" & Rows.Count).End(xlUp).Row)
        For i = 1 To bteNumOfDays
            If blnFirstText = True Then
                wsOutputTab.Cells(3, "A") = wsSourceTab.Range("A1") + i - 1
                wsOutputTab.Cells(3, "B") = rngMyCell.Value
                blnFirstText = False
            Else
                wsOutputTab.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = wsSourceTab.Range("A1") + i - 1
                wsOutputTab.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0) = rngMyCell.Value
            End If
        Next i
    Next rngMyCell
    
    Application.ScreenUpdating = True
    
    MsgBox "Data has now been copied.", vbInformation

End Sub

Robert

 

[TheJonWithNoH]

I'm not getting any errors or anything, but the code is only copying one line, nothing is showing below that or repeating x number of times.

 

[TheJonWithNoH]

Never mind, I had some data in some cells below (in columns A & B) and it was populating below that, so I cleared that data and now it is working for January, but when it comes to February and the following months the code is not populating the sheet for those months.

 

[Trebor76]

So what part does the date in cell A1 of the "master sheet" have in this? Do you only want the data to be copied from the month that's entered in that cell or always for 12 months i.e. if 1-May-2019 is in cell A1 copy from 1-May-2019 to 31-Dec-12 or always 1-Jan-2019 to 31-Dec-2019?

Should the data be cleared from A3:B[last row] each time the procedure is run?

 

[TheJonWithNoH]

Sorry I should have specified. The date in cell A1 of the master sheet is formatted as "yyyy" and should always update for the entire calendar year (1/1 - 12/31) and should be cleared every time the procedure is run.

 

[Eric W]

If I read this correctly, a formula could work. Try putting this in B3 and drag down as far as needed.

=IF(AND(B2=EOMONTH(B2,0),COUNTIF(B$2:B2,B2)<4),EOMONTH(B2,-1),B2)+1

It would automatically update as A2 on the master sheet is updated. Potentially you might want to add a condition that returns an empty cell after the 4th iteration of Dec 31, or possibly some other stopping condition.