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:

A	B
Apples	1/1/2020
Apples	1/2/2020
Apples	1/3/2020
Apples	1/4/2020
Apples	1/5/2020
......	....... All the way down to the end of the month
Apples	1/31/2020
Oranges	1/1/2020
Oranges	1/2/2020
Oranges	1/3/2020
.....	..... All the way down to the end of the month
Oranges	1/31/2020
Bananas	1/1/2020
......	.... All the way down to the end of the month
Bananas	1/31/2020
Apples	2/1/2020 (start over with apples for new month)
Apples	2/2/2020

<tbody>
</tbody>

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]

should always update for the entire calendar year (1/1 - 12/31)

So the entered date in cell A1 of the "master sheet" has no bearing on this?

 

[TheJonWithNoH]

The date entered in cell A1 on the master sheet controls the year in which the “sheet 2” will display

 

[Trebor76]

Hmmm...that doesn't answer the question

I can't get the dates to copy down properly in any case I'm afraid I'm sure someone on the forum will be able though

 

[Trebor76]

Actually try this:

Option Explicit
Sub Macro1()

    Dim wsSourceTab As Worksheet
    Dim wsOutputTab As Worksheet
    Dim strMyData() As String
    Dim lngArrayIndex As Long
    Dim lngLastRow As Long, lngMyRow As Long
    Dim rngMyCell As Range
    Dim intDay As Integer

    Application.ScreenUpdating = False

    Set wsSourceTab = Sheets("master sheet")
    Set wsOutputTab = Sheets("Sheet2") 'Change to suit

    'Clear any existing data
    lngLastRow = wsOutputTab.Range("A:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If lngLastRow >= 3 Then
        wsOutputTab.Range("A3:B" & lngLastRow).ClearContents
    End If

    'Create an array of all the data to be copied
    lngLastRow = wsOutputTab.Cells(Rows.Count, "AB").End(xlUp).Row
    For Each rngMyCell In wsOutputTab.Range("AB2:AB" & lngLastRow)
        ReDim Preserve strMyData(lngArrayIndex)
        strMyData(lngArrayIndex) = rngMyCell.Value
        lngArrayIndex = lngArrayIndex + 1
    Next rngMyCell

    lngLastRow = wsOutputTab.Cells(Rows.Count, "AD").End(xlUp).Row

    For Each rngMyCell In wsOutputTab.Range("AD2:AD" & lngLastRow)
        For lngArrayIndex = LBound(strMyData) To UBound(strMyData)
            For intDay = 1 To Val(rngMyCell.Value)
                If lngMyRow = 0 Then
                    lngMyRow = 3 'Initial output row. Change to suit if necessary.
                    Range("A" & lngMyRow).Value = CDate(intDay & "/" & Month(rngMyCell.Offset(0, -1)) & "/" & Year(wsSourceTab.Range("A1")))
                    Range("B" & lngMyRow).Value = strMyData(lngArrayIndex)
                Else
                    lngMyRow = lngMyRow + 1
                    Range("A" & lngMyRow).Value = CDate(intDay & "/" & Month(rngMyCell.Offset(0, -1)) & "/" & Year(wsSourceTab.Range("A1")))
                    Range("B" & lngMyRow).Value = strMyData(lngArrayIndex)
                End If
            Next intDay
        Next lngArrayIndex
    Next rngMyCell

    Application.ScreenUpdating = True

    MsgBox "Data has now been copied.", vbInformation

End Sub

Robert