Hello,

Below you will find a yearly calendar vba code that creates a worksheet for
each month at one time. I would like to change the calendar to monthly using
a input box choosing the month and year. How can I modify the code to use a
input box to select the month and year so that is will create one worksheet
for a selected month and year?

Option Explicit
Sub BuildCalendar_North()

'Need activeworkbook sheet named Event List:
'first event name in A2
'the date in B2 and so forth down the column
'with no breaks or interruptions

Dim yr As Long
Dim sName As String
Dim StartDate As Date
Dim EndDate As Date
Dim sh As Worksheet
Dim rng As Range, cell As Range
Dim dt As Date, s As String
Dim idex As Long, i As Long
Dim v(1 To 366) As String
Dim nt As Variant
Application.ScreenUpdating = False
With Worksheets("Settings_North")
dt = .Cells(2, 2).Value
yr = Year(dt)
nt = .Cells(2, 6).Value
StartDate = DateSerial(yr, 1, 1)
EndDate = DateSerial(yr, 12, 31)
Set rng = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))

End With
For Each cell In rng
idex = cell.Offset(0, 1).Value - StartDate + 1
v(idex) = v(idex) & Chr(10) & cell.Value
Next

For i = 1 To 12
On Error Resume Next
Application.DisplayAlerts = False
sName = Format(DateSerial(yr, i, 1), "mmmm")
Worksheets(sName).Delete
Application.DisplayAlerts = False
On Error GoTo 0
Next i
Worksheets.Add after:=Worksheets(Worksheets.Count)
Set sh = ActiveSheet
For i = StartDate To EndDate
If Day(i) = 1 Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
Set sh = ActiveSheet
sh.Name = Format(i, "mmmm")
MakeCalendar_North sh, yr, v
End If
sh.Name = [A1] & " " & [G1]
Next
Application.ScreenUpdating = True 'False
End Sub

Sub MakeCalendar_North(sh As Worksheet, yr As Long, v() As String)
Dim dt As Date, dt1 As Date
Dim i As Long, j As Long, k As Long
Dim l As Long, m As Long, n As Long
Dim cell As Range, rw As Long, col As Long

Application.ScreenUpdating = False

sh.Range("A:G").EntireColumn.ColumnWidth = 22
sh.Rows(1).RowHeight = 30
With sh.Cells(1, 1).Resize(1, 7)
.HorizontalAlignment = xlLeft 'xlCenterAcrossSelection
.VerticalAlignment = xlCenter
End With
sh.Cells(1, 1).Value = "'" & sh.Name & " " & yr
sh.Cells(1, 1).Font.Bold = True
sh.Cells(1, 1).Font.Size = 20
sh.Cells(1, 7).Value = "NORTH"
sh.Cells(1, 7).Font.Bold = True
sh.Cells(1, 7).Font.Size = 18
With sh.Cells(2, 1).Resize(1, 7)
.Value = Array("Sunday", "Monday", _
"Tuesday", "Wednesday", "Thursday", _
"Friday", "Saturday")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Bold = True
.Font.Size = 16
.EntireRow.RowHeight = 20
End With
For Each cell In sh.Cells(2, 1).Resize(7, 7)
cell.BorderAround Weight:=xlMedium
cell.WrapText = True
If cell.Row = 3 Then
cell.HorizontalAlignment = xlLeft
cell.VerticalAlignment = xlTop
End If
Next
dt = DateValue(sh.Name & " 1," & yr)
i = Weekday(dt, vbSunday)
dt1 = DateSerial(Year(dt), Month(dt) + 1, 0)
n = dt - DateSerial(Year(dt), 1, 1)
col = i
rw = 3
For k = Day(dt) To Day(dt1)
n = n + 1
Cells(rw, col).Value = Trim(k & v(n))
Cells(rw, col).BorderAround Weight:=xlMedium
col = col + 1
If col 7 Then
col = 1
rw = rw + 1
End If
Next
sh.Cells(3, 1).Resize(6, 1).EntireRow.RowHeight = 95

Range("A3:G8").Select
With Selection.Font
.Name = "Arial"
.Size = 12
End With

With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = -3
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape 'xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = True 'False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.DisplayGridlines = False
Range("A3").Select
Application.ScreenUpdating = True 'False

End Sub

Thank you for your help in advance,
James