Macro for Daily Calendar per month with Template

elysenic

New Member
Joined
Sep 9, 2022
Messages
3
Office Version
  1. 365
Platform
  1. Windows
I am trying to create an excel calendar for my boss. He'd like it to be based off of a daily calendar template in excel and to generate sequential daily tabs for an entire month, with us inputting the date (not using the current date as start date). I have 2 macros that I was able to create that we essentially want to combine in a manner.

This is the macro with the template that I was able to configure for monthly tabs for the entire year.
Sub AddYearly()
Dim wbk As Workbook
Dim wsh As Worksheet
Dim i As Long
Application.ScreenUpdating = False
Set wbk = ActiveWorkbook
Set wsh = wbk.Worksheets("Daily Calendar")
For i = 1 To 12
wsh.Copy After:=wbk.Worksheets(wbk.Worksheets.Count)
wbk.Worksheets(wbk.Worksheets.Count).Name = MonthName(i)
Next i
Application.ScreenUpdating = True
End Sub

Then I have the macro with the sequential daily tabs, but it starts on the current date, i.e. I can't make it for specific months at a time and keep them in individual workbooks (ex: 1 for September, 1 for October, etc).
Sub daily_calendar()

Dim sh As Worksheet, nsh As Worksheet
Dim nextdate As Date
Dim ndate As Date
Dim x As Integer
Dim startdate As Date
x = 1

Worksheets("Sheet1").Range("A1").Select
Worksheets("Sheet1").Range("A1").NumberFormat = ("[$-x-sysdate]dddd, mmmm dd, yyyy")
Worksheets("Sheet1").Range("A1").Value = Date
Cells.EntireColumn.AutoFit

startdate = Worksheets("Sheet1").Range("A1").Value

'Pulls a total of 31 days into the spreadsheet.
For x = 1 To 31
nextdate = startdate + x
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Range("A1").NumberFormat = ("[$-x-sysdate]dddd, mmmm dd, yyyy")
ActiveSheet.Range("A1").Value = nextdate
Cells.EntireColumn.AutoFit
ActiveSheet.Name = Format(nextdate, "[$-x-sysdate]dddd, mmmm dd, yyyy")

Next
End Sub

Thank you in advance!
 

Attachments

  • Add Yearly Macro Template.jpg
    Add Yearly Macro Template.jpg
    55.4 KB · Views: 78

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Not sure if your goal is to create one workbook for the entire year or one workbook for each month.
Irregardless, this macro will produce one sheet for each day of the month given a date within that month.

VBA Code:
Sub daily_calendar()
    Dim dateEntered As String
    Dim theMnth As Long, theYr As Long
    Dim x As Long, mnthEnd As Long

    dateEntered = Application.InputBox("input a start date (m/d/yyyy)" & vbLf & _
                  "sheets will start from the 1st of the month", "MONTH OF SHEETS TO GENERATE")
    If IsDate(dateEntered) Then
        theMnth = Month(dateEntered)
        theYr = Year(dateEntered)
        mnthEnd = Day(Application.WorksheetFunction.EoMonth(dateEntered, 0))
    Else
        MsgBox "Oops, a date has not been entered as required"
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    For x = 1 To mnthEnd
        Sheets.Add After:=Sheets(Sheets.Count)
        With ActiveSheet
            .Range("A1") = "DATE"
            .Range("B1").NumberFormat = ("[$-x-sysdate]dddd, mmmm dd, yyyy")
            .Range("B1").Value = DateSerial(theYr, theMnth, x)
            .Cells.EntireColumn.AutoFit
            .Name = Format(.Range("B1").Value, "dddd mmmm dd yyyy")
        End With
    Next x
    Application.ScreenUpdating = True
End Sub


Hope this helps.
 
Upvote 0
Thank you, yes I was looking for one workbook per month so this meets that request.

It still didn't pull the template to each sheet, though?
 
Upvote 0
It still didn't pull the template to each sheet, though?
I've never worked with templates before.
I know that Sheets.Add adds a blank sheet so
I'd guess you would need to copy the template sheet similar to what you've done in the AddYearly macro.
 
Upvote 0
I've never worked with templates before.
I know that Sheets.Add adds a blank sheet so
I'd guess you would need to copy the template sheet similar to what you've done in the AddYearly macro.
Thank you for your help.
 
Upvote 0

Forum statistics

Threads
1,223,098
Messages
6,170,100
Members
452,301
Latest member
QualityAssurance

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