Date Series - first date of the Week

Charlie987

New Member
Joined
Jul 25, 2020
Messages
22
Office Version
  1. 365
Platform
  1. Windows
Hi,
I was hoping to be able to create a date series in excel from the following method:
On a button click, generate a dialog box asking: Enter month and year (but am thinking it may be easiest to just ask for the first of the month eg 1/12/20).
from that,
Starting from E1 of a dynamically created workbook that will hopefully be created on the same click, a series of dates that determine the date of each Monday in that month listed across the row. (where each date is stated twice) (Also if was possible to indicate how I would alter the code to change to only one listing of the date that would be fantastic!)
eg.
Enter Date: 1/12/20
output:
7/12/20 | 7/12/20 | 14/12/20 | 14/12/20 | 21/12/20 | 21/12/20 | 28/12/20 | 28/12/20

I'm not sure how big of a task this is so if not too much trouble was hoping anyone might have some ideas on how to implement
Thank you!
 

Some videos you may like

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,238
Try this macro. The important thing is to enter the date, when prompted, in the described format which is: yyyy/mm/01 This would be the first of the desired month and year.
Rich (BB code):
Sub Charlie()
    Application.ScreenUpdating = False
    Dim response As String, d As Date, x As Long: x = 1
    response = InputBox("Enter the date in the format: yyyy/mm/01", "1st of the month")
    If Right(response, 2) <> "01" Then
        MsgBox ("Please enter the date in the format: 'yyyy/mm/01' with '01' as the day.")
        Exit Sub
    End If
    d = response
    Workbooks.Add
    Do
        intDay = intDay + 1
        If Format(d + intDay, "ddd") = "Mon" Then
            Cells(1, x).Resize(, 2) = DateSerial(Year(d), Month(d), Format(d + intDay, "d"))
            x = x + 2
        End If
    Loop Until Format(d + intDay, "mmm") <> Format(d + intDay + 1, "mmm")
    Application.ScreenUpdating = True
End Sub
If you want only one listing of the date, change the "2" (in red) in the code to "1".
Rich (BB code):
 

Charlie987

New Member
Joined
Jul 25, 2020
Messages
22
Office Version
  1. 365
Platform
  1. Windows
Thank you! that is fantastic. Works perfectly
Thank you very much!
 

Charlie987

New Member
Joined
Jul 25, 2020
Messages
22
Office Version
  1. 365
Platform
  1. Windows
Not sure if you might be able to help with this one as well:
I am hoping to be able to create a new workbook from a list contained in another work book where:
Work book 1 contains the list:
Numbers | First name | Last name | Number2
1234 | John | Smith | 1
4321 | Paul | Adams | 4
2344 | Sam | White | 4

Where the new work book will duplicate this list a certain number of times and apply a date column to it.
similarly, where I can specify a month and the date column could be the date of the Monday for each week and the number of Mondays would be how many times the list is duplicated.
eg.
Enter month: 01/12/20
output:
1234 | John | Smith | 1 | 7/12/20
4321 | Paul | Adams | 4 | 7/12/20
2344 | Sam | White | 4 | 7/12/20
1234 | John | Smith | 1 | 14/12/20
4321 | Paul | Adams | 4 | 14/12/20
2344 | Sam | White | 4 | 14/12/20
1234 | John | Smith | 1 | 21/12/20
4321 | Paul | Adams | 4 | 21/12/20
2344 | Sam | White | 4 | 21/12/20
1234 | John | Smith | 1 | 28/12/20
4321 | Paul | Adams | 4 | 28/12/20
2344 | Sam | White | 4 | 28/12/20

so there is 4 repetitions of the list but in a different month the list may be repeated 5 times depending on the number of weeks
if you had any thoughts on that one I would greatly appreciate it
Thanks
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,238

ADVERTISEMENT

Try:
VBA Code:
Sub Charlie2()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, LastRow As Long, rng As Range, response As String, d As Date
    Set srcWS = ThisWorkbook.Sheets("Sheet1")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    response = InputBox("Enter the date in the format: yyyy/mm/01", "1st of the month")
    If Right(response, 2) <> "01" Then
        MsgBox ("Please enter the date in the format: 'yyyy/mm/01' with '01' as the day.")
        Exit Sub
    End If
    d = response
    Workbooks.Add
    Do
        intDay = intDay + 1
        If Format(d + intDay, "ddd") = "Mon" Then
            srcWS.UsedRange.Offset(1).Copy Cells(Rows.Count, "A").End(xlUp).Offset(1)
            Cells(Rows.Count, "E").End(xlUp).Offset(1).Resize(LastRow - 1) = DateSerial(Year(d), Month(d), Format(d + intDay, "d"))
        End If
    Loop Until Format(d + intDay, "mmm") <> Format(d + intDay + 1, "mmm")
    Application.ScreenUpdating = True
End Sub
 

Charlie987

New Member
Joined
Jul 25, 2020
Messages
22
Office Version
  1. 365
Platform
  1. Windows
Fantastic. that's perfect once again.
Thank you so much
 

Charlie987

New Member
Joined
Jul 25, 2020
Messages
22
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Hi,
it all looking really great! Just with the first one, when I did the one with the change to 1 so that it was only one instance of the dates, it worked well but the last date appeared twice. eg. 7/12/20, 14/12/20, 21/12/20, 28/12/20, 28/12/20
Just wondering if you knew what I might be able to adjust to get that last one to stop after one.
Thanks again!
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,238
Replace this code:
VBA Code:
Cells(1, x).Resize(, 2) = DateSerial(Year(d), Month(d), Format(d + intDay, "d"))
x = x + 2
with this:
VBA Code:
Cells(1, x) = DateSerial(Year(d), Month(d), Format(d + intDay, "d"))
x = x + 1
 

Watch MrExcel Video

Forum statistics

Threads
1,127,082
Messages
5,622,567
Members
415,907
Latest member
Walters87

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
Top