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]

Also one more thing it needs to have a date picker that will create a whole year worth or a month at a time, either way is fine.

Thanks in advance.

 

[Logit]

Please post a copy of your example workbook to a download website (DropBox.com, etc).

 

[stolenweasel]

Please post a copy of your example workbook to a download website (DropBox.com, etc).

Thank you for the reply, when i go to work this evening i will see if i can make that work. I work graveyard so you should see it in the morning. I dont use Dropbox or anything like that much so i will have to revive that knowledge.

 

[stolenweasel]

Please post a copy of your example workbook to a download website (DropBox.com, etc).

6.1.23.xlsx

Shared with Dropbox

www.dropbox.com

 

[stolenweasel]

Please post a copy of your example workbook to a download website (DropBox.com, etc).

Did the link work?

 

[Logit]

Yes, the link is successful. Reviewing the workbook layout now. Will let you know something in a day or so.

 

[stolenweasel]

Yes, the link is successful. Reviewing the workbook layout now. Will let you know something in a day or so.

Ok sweet thank you

 

[stolenweasel]

Yes, the link is successful. Reviewing the workbook layout now. Will let you know something in a day or so.

So i found something similar on this site. I tweaked it to fit what i need. This appears to work. Is there better options than this? Thanks again for your help.



Sub ANIMATE_SUPLOG()
Application.ScreenUpdating = False
Dim Mth As Long, dy As Long, DaysInMonth As Long, yr As String, srcWS As Worksheet
Set srcWS = ThisWorkbook.Sheets("Template") 'Name of worksheet that will be compiled to new workbook
askyear:
yr = InputBox("Enter the Year number required" _
& vbCrLf & "in the format of YYYY e.g. " & "2023" _
& vbCrLf & "" _
, "Enter Year Number")
If yr = "" Or Val(yr) = 0 Then Exit Sub
If Val(yr) < 1999 Or Val(yr) > 2100 Then
GoTo askyear
End If
For Mth = 1 To 12
DaysInMonth = DateSerial(yr, Mth + 1, 1) - DateSerial(yr, Mth, 1)
srcWS.Copy
For dy = 1 To DaysInMonth
Sheets(1).Copy After:=Sheets(Sheets.Count)
With ActiveSheet
.Name = Format(DateSerial(yr, Mth, dy), "dd MMM yy")
.Range("H2") = Format(DateSerial(yr, Mth, dy), "dd MMMM yyyy")
End With
Next dy
Application.DisplayAlerts = False
Sheets(1).Delete
Application.DisplayAlerts = True
With ActiveWorkbook
.SaveAs ThisWorkbook.Path & Application.PathSeparator & "Sup Log " & Format(Mth, "00") & " " & MonthName(Mth) & " " & yr & ".xlsx", FileFormat:=51
.Close False
End With
Next Mth
Application.ScreenUpdating = True
End Sub

 

[Logit]

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