Create new sheet on opening workbook depenant on todays date

[AkaTrouble]

Hello

limited skills excel user here trying to help even lower skilled friend offsite

i have created a workbook containing a "master" sheet which contains presently a predefined weekly planner Monday through Sunday

i have used some formula to show the days and dates based on a week start date field that presently is added manually, i also have some formatting for display etc and print area defined for printing on single sheet.

presently i create a new sheet copy and paste the contents of "master" or create copy of "master" rename the sheet to the start date and move to required place in page tabs.

what i would like to do is create an on opening event (i think this is what it is called) that checks todays date finds the Monday date for the week and checks if there is a page for this week and the next. If there is do nothing and if not create a sheet based on the "master" sheet and label it with the Monday date, then to check if there is a sheet = to next weeks Monday date and if not create it.

example todays date = 20th Dec 2014. so would need to check if there is a sheet named 15th Dec 2014 and also 22nd Dec 2014 (next week)

if not to create them with copy of contents of "master" sheet


hope i have explained this well enough

thanks for reading

 

[par60056]

In the VBA editor, find the "ThisWorkbook" object and dbl click. You will get a window titled "bookName - ThisWorkbook". In the left dropdown select workbook and you should get a workbook open event procedure.

Try this and see if it does what you want.

Private Sub Workbook_Open()
Dim sht As Worksheet
Dim shtName As String
Dim aDate As Date


aDate = Int(Now())
aDate = aDate - (Weekday(aDate, vbMonday) - 1)


shtName = Format(aDate, "dd Mmm, yyyy")
On Error Resume Next
Set sht = Sheets(shtName)
On Error GoTo 0


If (sht Is Nothing) Then
    Sheets.Add.Name = shtName
    Sheets("Master").Cells.Copy
    Range("A1").PasteSpecial xlPasteAll
End If


shtName = Format(aDate + 7, "dd Mmm, yyyy")
On Error Resume Next
Set sht = Sheets(shtName)
On Error GoTo 0


If (sht Is Nothing) Then
    Sheets.Add.Name = shtName
    Sheets("Master").Cells.Copy
    Range("A1").PasteSpecial xlPasteAll
End If


End Sub

 

[AkaTrouble]

that was very quick reply

it works perfectly and does exactly as asked


only one question the tabs are created perfectly newest date to left ...

is there anyway to keep the master tab to far left ???

also (cheeky i know )

would the code be difficult to modify to complete same task for one sheet per day and one sheet per month ??

but again THANKS is twice in two day you have made my life a little easier

 

[AkaTrouble]

if anyone thinking of using and benefiting from above great code frompar60056

i also added this line of code to field A1 on "master" sheet to insert sheet name into this field

=MID(CELL("filename"),FIND("]",CELL("filename"))+1,30)

this will allow you to reference this cell to name your days and date them allowing you to create you own planner layout

this will update every week adding a new week automatically

might make a great diary template too

 

[par60056]

The first part is easy. Change the 2 lines that say :
Sheets.Add.Name = shtName
to
Sheets.Add(after:=Sheets("Master")).Name = shtName

This will add the new sheets right after the Master sheet keeping the Master to the left.

Adding a daily and a monthly is only a little more difficult BUT it creates a problem. You need to do something about how you name the sheets. You need a way to differentiate daily from weekly from monthly. There could be as many as 3 sheets for a date.

This is simply done by changing the way the shtName is created. This is going to create a lot of sheets and they will be in the order created. There are things that you can do to change what sheet they are added after but that is more complicated.(not impossible but I don't have time to write it right now)

Dim sht As Worksheet
Dim shtName As String
Dim aDate As Date


aDate = Int(Now())
shtName = "Daily " & Format(aDate, "dd Mmm, yyyy")
On Error Resume Next
Set sht = Sheets(shtName)
On Error GoTo 0


If (sht Is Nothing) Then
    Sheets.Add(after:=Sheets("Master")).Name = shtName
    Sheets("Master").Cells.Copy
    Range("A1").PasteSpecial xlPasteAll
End If


shtName = "Monthly " & Format(aDate, "01 Mmm, yyyy")
On Error Resume Next
Set sht = Sheets(shtName)
On Error GoTo 0


If (sht Is Nothing) Then
    Sheets.Add(after:=Sheets("Master")).Name = shtName
    Sheets("Master").Cells.Copy
    Range("A1").PasteSpecial xlPasteAll
End If


aDate = aDate - (Weekday(aDate, vbMonday) - 1)
shtName = "Weekly " & Format(aDate, "dd Mmm, yyyy")
On Error Resume Next
Set sht = Sheets(shtName)
On Error GoTo 0


If (sht Is Nothing) Then
    Sheets.Add(after:=Sheets("Master")).Name = shtName
    Sheets("Master").Cells.Copy
    Range("A1").PasteSpecial xlPasteAll
End If


shtName = "Weekly " & Format(aDate + 7, "dd Mmm, yyyy")
On Error Resume Next
Set sht = Sheets(shtName)
On Error GoTo 0


If (sht Is Nothing) Then
    Sheets.Add(after:=Sheets("Master")).Name = shtName
    Sheets("Master").Cells.Copy
    Range("A1").PasteSpecial xlPasteAll
End If

that was very quick reply

it works perfectly and does exactly as asked


only one question the tabs are created perfectly newest date to left ...

is there anyway to keep the master tab to far left ???

also (cheeky i know )

would the code be difficult to modify to complete same task for one sheet per day and one sheet per month ??

but again THANKS is twice in two day you have made my life a little easier

 

[AkaTrouble]

thanks will play with this code

and to explain better

i was thinking separate workbooks for daily and separate work books for monthly

if need to combine data then a new book to combine the data into lets say a year book and that would be user descretion

but thanks

 

[par60056]

New workbooks is a little more involved. You need to add the workbook and save it to associate the name with it. All new workbooks have a name like "Book10" until saved.

 

[AkaTrouble]

no i mean your original code for creating a new page weekly ( which works perfectly )

having a new work book not associated with weekly

for a daily creation of a sheet lets say up to 7-10 days from todays date if not existing

and another totally independent workbook for monthly sheet created this month and next if not exist

3 separate workbooks not associated

if information needed across books then yes that gets really complicated

 

[par60056]

Ah ok then you just need to take the code above has all the bits you need. Copy it into the 3 books and remove the sections that you don't need. The "Daily" book remove where shtName="Weekly" or "Monthly" Do the same for the other 2.

Daily:

Dim sht As Worksheet
Dim shtName As String
Dim aDate As Date


aDate = Int(Now())
shtName = Format(aDate, "dd Mmm, yyyy")
On Error Resume Next
Set sht = Sheets(shtName)
On Error GoTo 0


If (sht Is Nothing) Then
    Sheets.Add(after:=Sheets("Master")).Name = shtName
    Sheets("Master").Cells.Copy
    Range("A1").PasteSpecial xlPasteAll
End If

Monthly:

Dim sht As Worksheet
Dim shtName As String
Dim aDate As Date


aDate = Int(Now())


shtName = Format(aDate, "01 Mmm, yyyy")
On Error Resume Next
Set sht = Sheets(shtName)
On Error GoTo 0


If (sht Is Nothing) Then
    Sheets.Add(after:=Sheets("Master")).Name = shtName
    Sheets("Master").Cells.Copy
    Range("A1").PasteSpecial xlPasteAll
End If

 

[AkaTrouble]

thanks will have a play and come back and post results

although am sure will only be to confirm them

Thank You