Repeat Values and Range of Dates Based on Cell Values

TheJonWithNoH

New Member
Joined
Sep 8, 2017
Messages
30
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:

AB
Apples1/1/2020
Apples1/2/2020
Apples1/3/2020
Apples1/4/2020
Apples1/5/2020
...... ....... All the way down to the end of the month
Apples1/31/2020
Oranges1/1/2020
Oranges1/2/2020
Oranges1/3/2020
.......... All the way down to the end of the month
Oranges1/31/2020
Bananas1/1/2020
.......... All the way down to the end of the month
Bananas1/31/2020
Apples2/1/2020 (start over with apples for new month)
Apples2/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
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
Hi Jon,

Try this (note my comments as well):

Code:
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
 
Upvote 0
Just noticed I forgot the dates!!

Try this instead:

Code:
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
 
Upvote 0
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! :)
 
Upvote 0
Try this:

Code:
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
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
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?
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,520
Messages
6,114,099
Members
448,548
Latest member
harryls

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top