Supervisor log sheet for each day of the month.

[stolenweasel]

I have a sheet that I am trying to automate that we use for each day of the month. Right now we have a seperate file for each day that contains one sheet/tab. The sheet is dated in the top right in cell H2. I would like the script to populate either a new file per day with the name of the file being mm dd yy and also populating the corresponding date in H2 for each day. Im not opposed to one file for the month with 28+ days as tabs. The tabs would need to copy the sheet, be named for the dates and also rename H2 to the corresponding date.

 

[stolenweasel]

Option Explicit

Sub CreateSheets()
Dim strDate As String
Dim NumDays As Long
Dim i As Long
Dim sh As Object
Dim wsBase As Worksheet
On Error GoTo EndIt
   
' The Do statement to captures Month/Year via Input Box
' and return number of days in the month to the NumDays variable
    Do
        strDate = Application.InputBox( _
            Prompt:="Please enter month and year: mm/yyyy", _
            Title:="Month and Year", _
            Default:=Format(Date, "mm/yyyy"), _
            Type:=2)
 
        If strDate = "False" Then Exit Sub
        If IsDate(strDate) Then Exit Do
        If MsgBox("Please enter a valid date, such as ""01/2010""." _
            & vbLf & vbLf & "Shall we try again?", vbYesNo + vbExclamation, _
            "Invalid Date") = vbNo Then End
    Loop
   
    Application.ScreenUpdating = False
    NumDays = Day(DateSerial(Year(strDate), Month(strDate) + 1, 0))
    Set wsBase = Sheets("Template")
   
' For each day, the For statement below copies the template sheet 'n' times
    For i = 1 To NumDays
        wsBase.Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = Format(DateSerial(Year(strDate), Month(strDate), i), "ddd mmm dd")
    Next i
EndIt:
    Application.ScreenUpdating = True
End Sub

Paste the following in the ThisWorkbook module :

Option Explicit

Private Sub Workbook_Open()
    On Error Resume Next
    Sheets(Format(Date, "ddd mmm dd")).Select
End Sub

Thank you, ill check it out when i get back to work.

 

[Logit]

I re-read you initial request and see H2 should change to the same date as the tab name.
Here is a slight edit to the large macro :

Option Explicit
    
    Sub CreateSheets()
    Dim strDate As String
    Dim NumDays As Long
    Dim i As Long
    Dim sh As Object
    Dim wsBase As Worksheet
    On Error GoTo EndIt
        
    ' The Do statement to captures Month/Year via Input Box
    ' and return number of days in the month to the NumDays variable
        Do
            strDate = Application.InputBox( _
                Prompt:="Please enter month and year: mm/yyyy", _
                Title:="Month and Year", _
                Default:=Format(Date, "mm/yyyy"), _
                Type:=2)
    
            If strDate = "False" Then Exit Sub
            If IsDate(strDate) Then Exit Do
            If MsgBox("Please enter a valid date, such as ""01/2010""." _
                & vbLf & vbLf & "Shall we try again?", vbYesNo + vbExclamation, _
                "Invalid Date") = vbNo Then End
        Loop
        
        Application.ScreenUpdating = False
        NumDays = Day(DateSerial(Year(strDate), Month(strDate) + 1, 0))
        Set wsBase = Sheets("Template")
        
    ' For each day, the For statement below copies the template sheet 'n' times
    Dim x As String
        For i = 1 To NumDays
            wsBase.Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = Format(DateSerial(Year(strDate), Month(strDate), i), "ddd mmm dd")
            x = Format(DateSerial(Year(strDate), Month(strDate), i), "mm/dd/yyyy")
            [H2].Value = x
        Next i
EndIt:
        Application.ScreenUpdating = True
    End Sub