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

 

[AkaTrouble]

IMPORTANT

IF YOU ARE USING THIS CODE THE WORKBOOK MUST HAVE A SHEET CALLED master or code will fail

=======================================================================================


par60056

the separate code for weekly and monthly work ok

on the monthly code the sheet name is returning 421 Mmm yyyy


also what code do i need to change to make them do similar to the weekly code

as in on monthly code to create this month and next month

and on the daily code to create today and then the next 7 sheets if not exist

hope this makes sense and thanks for you continued help

 

[par60056]

Yes there must be a "Master" sheet. You can call it whatever you want but you will need to change that in the code.

Guess it didn't like my easy way to make it the 1st of the month. This code does it right.

I put each in their own routine. you can copy them to the appropriate worksheet event.

Sub Weekly()
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")
' ignore error on set.  If the sheet doesn't exist, then you would get an error.
' but with the "resume next", the macro continues and SHT is just set to NOTHING
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


'Add 7 days to the previos monday to get the next one
shtName = Format(aDate + 7, "dd Mmm, yyyy")
' ignore error on set.  If the sheet doesn't exist, then you would get an error.
' but with the "resume next", the macro continues and SHT is just set to NOTHING
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


End Sub
Sub Daily()
Dim sht As Worksheet
Dim shtName As String
Dim aDate As Date
Dim addDay As Integer


aDate = Int(Now())
'loop 7 times to get today and the next 6 days.  if this is run every day only the last sheet should need to be created each day.
For addDay = 0 To 6
    shtName = Format(aDate + addDay, "dd Mmm, yyyy")
    ' ignore error on set.  If the sheet doesn't exist, then you would get an error.
    ' but with the "resume next", the macro continues and SHT is just set to NOTHING
    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
Next
End Sub
Sub Monthly()
Dim sht As Worksheet
Dim shtName As String
Dim aDate As Date
Dim addDay As Integer


aDate = Int(Now())


shtName = Format(aDate - Day(aDate) + 1, "dd Mmm, yyyy")
' ignore error on set.  If the sheet doesn't exist, then you would get an error.
' but with the "resume next", the macro continues and SHT is just set to NOTHING
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


'add a month to the current date and generate the new sheet name
aDate = DateAdd("M", 1, aDate)
shtName = Format(aDate - Day(aDate) + 1, "dd Mmm, yyyy")
' ignore error on set.  If the sheet doesn't exist, then you would get an error.
' but with the "resume next", the macro continues and SHT is just set to NOTHING
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


End Sub

 

[AkaTrouble]

thanks very much yepp as a macro set in a module the 3 options work great

had issue returning compile error when splitting and placing into open book event

could just be i tested in open book prior to saving will close all and create new


thanks for the remarks statement help me understand the changes from earlier

i may put a line at top of each routine to check for "master" sheet and if not exist create a blank one then continue

 

[AkaTrouble]

ok to confirm all codes work

the compile error i was getting was simply in copy the parts of code to the on open event i failed to remove the subs set name variable from the code

example for the on open event for the daily option from the code above this is all that is needed

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


    aDate = Int(Now())
    'loop 7 times to get today and the next 6 days.  if this is run every day only the last sheet should need to be created each day.
    For addDay = 0 To 6
        shtName = Format(aDate + addDay, "dd Mmm, yyyy")
        ' ignore error on set.  If the sheet doesn't exist, then you would get an error.
        ' but with the "resume next", the macro continues and SHT is just set to NOTHING
        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
    Next
    End Sub

thanks again hope this helps someone other than me as is a really cool thread and some brilliant help recieved

 

[par60056]

Glad it worked for you