Date Series - first date of the Week

Charlie987

New Member
Joined
Jul 25, 2020
Messages
25
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!
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
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):
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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!
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,972
Members
448,537
Latest member
Et_Cetera

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