Modify Yearly Calendar to Monthly Calendar Excel 2000?

J

James Cooper

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
 
J

Jim Cone

MS has already done it for you...
http://support.microsoft.com/kb/213795/en-us
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware


"James Cooper" <[email protected]>
wrote in message
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?
-snip-
 
T

Toppers

Try these changes

With Worksheets("Settings_North")
dt = .Cells(2, 2).Value
yr = Year(dt)
nt = .Cells(2, 6).Value
' ==> new code ....
dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy", Type:=2)
If Not IsDate(dt) Then
MsgBox "Invalid date"
Exit Sub
End If
yr = Year(dt)
StartDate = DateSerial(yr, Month(dt), 1)
EndDate = DateSerial(yr, Month(dt) + 1, 0)
'<==== End new code
Set rng = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))

End With
..
..
..
For i = Month(dt) To Month(dt)

HTH
 
J

jamesfc30

Hello Toppers,

Thank you for your quick response and the code. When I inserted the
code into the calendar it only creates a worksheet for January. I've
tried different dates in the input box but it only creates a worksheet
for January. Would you have any ideas on how to fix this?

Thak you again for your help,
James Cooper
 
J

jamesfc30

Hello Jim Cone,

Thank you for your quick response! How can I use the MS Calendar
2137595 to add Holidays and other dates to it using a worksheet?

Thank you for your help,
jfcby
 
J

Jim Cone

jfcby,
Unprotect the sheet and enter whatever you want.
There is a blank cell below each date.
If you are looking to add holidays using code, someone else,
with more motivation then I, would be required.
Jim Cone
San Francisco, USA
http://www.officeletter.com/blink/specialsort.html


<[email protected]>
wrote in message
Hello Jim Cone,
Thank you for your quick response! How can I use the MS Calendar
2137595 to add Holidays and other dates to it using a worksheet?
Thank you for your help,
jfcby
 
T

Toppers

James,
I (re) tried the code for date of "07/06" and it just produced
the calendar for July so I am not sure why you [only] got January. Perhaps
you can repost (that part of) the code that has changed.
 
J

jamesfc30

Hello Toppers,

Thank you for you for your help! This is the part of the code that has
changed and how I inserted the new code into current code:

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)

' ==> new code ....
dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy",
Type:=2)
If Not IsDate(dt) Then
MsgBox "Invalid date"
Exit Sub
End If
yr = Year(dt)
StartDate = DateSerial(yr, Month(dt), 1)
EndDate = DateSerial(yr, Month(dt) + 1, 0)
'<==== End new code

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 = Month(dt) To Month(dt)
'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

Thank you,
James Cooper

James,
I (re) tried the code for date of "07/06" and it just produced
the calendar for July so I am not sure why you [only] got January. Perhaps
you can repost (that part of) the code that has changed.



[email protected] said:
Hello Toppers,

Thank you for your quick response and the code. When I inserted the
code into the calendar it only creates a worksheet for January. I've
tried different dates in the input box but it only creates a worksheet
for January. Would you have any ideas on how to fix this?

Thak you again for your help,
James Cooper
Click to expand...
Click to expand...
 
T

Toppers

James,
I think this is the culprit:

dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy",
Type:=2)

It assumes date is in DD/MM/YY (UK) format whereas I am assuming yours is US
format (mm/dd/yy)!

You need to convert to use US format.

' dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy", Type:=2)
Dim mmyy As String
mmyy = Application.InputBox(prompt:="Input Date as mm/yy", Type:=2)
dt = Left(mmyy, 2) & "/01/" & Right(mmyy, 2) '<== US format

(The sooner we standardise on date formats the better!)

HTH


[email protected] said:
Hello Toppers,

Thank you for you for your help! This is the part of the code that has
changed and how I inserted the new code into current code:

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)

' ==> new code ....
dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy",
Type:=2)
If Not IsDate(dt) Then
MsgBox "Invalid date"
Exit Sub
End If
yr = Year(dt)
StartDate = DateSerial(yr, Month(dt), 1)
EndDate = DateSerial(yr, Month(dt) + 1, 0)
'<==== End new code

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 = Month(dt) To Month(dt)
'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

Thank you,
James Cooper

James,
I (re) tried the code for date of "07/06" and it just produced
the calendar for July so I am not sure why you [only] got January. Perhaps
you can repost (that part of) the code that has changed.



[email protected] said:
Hello Toppers,

Thank you for your quick response and the code. When I inserted the
code into the calendar it only creates a worksheet for January. I've
tried different dates in the input box but it only creates a worksheet
for January. Would you have any ideas on how to fix this?

Thak you again for your help,
James Cooper


Toppers wrote:
Try these changes

With Worksheets("Settings_North")
dt = .Cells(2, 2).Value
yr = Year(dt)
nt = .Cells(2, 6).Value
' ==> new code ....
dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy", Type:=2)
If Not IsDate(dt) Then
MsgBox "Invalid date"
Exit Sub
End If
yr = Year(dt)
StartDate = DateSerial(yr, Month(dt), 1)
EndDate = DateSerial(yr, Month(dt) + 1, 0)
'<==== End new code
Set rng = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))

End With
.
.
.
For i = Month(dt) To Month(dt)

HTH

:

MS has already done it for you...
http://support.microsoft.com/kb/213795/en-us
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware


"James Cooper" <[email protected]>
wrote in message
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?
-snip-
Click to expand...
Click to expand...
Click to expand...
 
J

jamesfc30

Hello Toppers,

Thank you for the previous code! I changed the code to US format but
now I'm receiving this error message "Run-time error '9': Subscript out
of range" then when I click the debug button it highlights this part of
the script:

v(idex) = v(idex) & Chr(10) & cell.Value

I'll include the changed code below:

Option Explicit
Sub BuildCalendar_North()

'Need activeworkbook sheet named Settings_North:
'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
Dim mmyy As String
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)

' ==> new code (UK)....
'dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy",
Type:=2) '==> UK format
mmyy = Application.InputBox(prompt:="Input Date as mm/yy", Type:=2)
dt = Left(mmyy, 2) & "/01/" & Right(mmyy, 2) '<== US format
If Not IsDate(dt) Then
MsgBox "Invalid date"
Exit Sub
End If
yr = Year(dt)
StartDate = DateSerial(yr, Month(dt), 1)
EndDate = DateSerial(yr, Month(dt) + 1, 0)
'<==== End new code



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 = Month(dt) To Month(dt)
'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

If you need other information please let me know!

Thank you for your help,
James Cooper
James,
I think this is the culprit:

dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy",
Type:=2)

It assumes date is in DD/MM/YY (UK) format whereas I am assuming yours is US
format (mm/dd/yy)!

You need to convert to use US format.

' dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy", Type:=2)
Dim mmyy As String
mmyy = Application.InputBox(prompt:="Input Date as mm/yy", Type:=2)
dt = Left(mmyy, 2) & "/01/" & Right(mmyy, 2) '<== US format

(The sooner we standardise on date formats the better!)

HTH


[email protected] said:
Hello Toppers,

Thank you for you for your help! This is the part of the code that has
changed and how I inserted the new code into current code:

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)

' ==> new code ....
dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy",
Type:=2)
If Not IsDate(dt) Then
MsgBox "Invalid date"
Exit Sub
End If
yr = Year(dt)
StartDate = DateSerial(yr, Month(dt), 1)
EndDate = DateSerial(yr, Month(dt) + 1, 0)
'<==== End new code

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 = Month(dt) To Month(dt)
'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

Thank you,
James Cooper

James,
I (re) tried the code for date of "07/06" and it just produced
the calendar for July so I am not sure why you [only] got January. Perhaps
you can repost (that part of) the code that has changed.



:

Hello Toppers,

Thank you for your quick response and the code. When I inserted the
code into the calendar it only creates a worksheet for January. I've
tried different dates in the input box but it only creates a worksheet
for January. Would you have any ideas on how to fix this?

Thak you again for your help,
James Cooper


Toppers wrote:
Try these changes

With Worksheets("Settings_North")
dt = .Cells(2, 2).Value
yr = Year(dt)
nt = .Cells(2, 6).Value
' ==> new code ....
dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy", Type:=2)
If Not IsDate(dt) Then
MsgBox "Invalid date"
Exit Sub
End If
yr = Year(dt)
StartDate = DateSerial(yr, Month(dt), 1)
EndDate = DateSerial(yr, Month(dt) + 1, 0)
'<==== End new code
Set rng = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))

End With
.
.
.
For i = Month(dt) To Month(dt)

HTH

:

MS has already done it for you...
http://support.microsoft.com/kb/213795/en-us
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware


"James Cooper" <[email protected]>
wrote in message
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?
-snip-
Click to expand...
Click to expand...
Click to expand...
 
T

Toppers

James,
Do you have (correct) data in the sheet "Settings_North" i.e.
is it US format? I received this error if there was no/incorrect data.

I was out all day yesterday so couldn't reply sooner.


[email protected] said:
Hello Toppers,

Thank you for the previous code! I changed the code to US format but
now I'm receiving this error message "Run-time error '9': Subscript out
of range" then when I click the debug button it highlights this part of
the script:

v(idex) = v(idex) & Chr(10) & cell.Value

I'll include the changed code below:

Option Explicit
Sub BuildCalendar_North()

'Need activeworkbook sheet named Settings_North:
'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
Dim mmyy As String
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)

' ==> new code (UK)....
'dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy",
Type:=2) '==> UK format
mmyy = Application.InputBox(prompt:="Input Date as mm/yy", Type:=2)
dt = Left(mmyy, 2) & "/01/" & Right(mmyy, 2) '<== US format
If Not IsDate(dt) Then
MsgBox "Invalid date"
Exit Sub
End If
yr = Year(dt)
StartDate = DateSerial(yr, Month(dt), 1)
EndDate = DateSerial(yr, Month(dt) + 1, 0)
'<==== End new code



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 = Month(dt) To Month(dt)
'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

If you need other information please let me know!

Thank you for your help,
James Cooper
James,
I think this is the culprit:

dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy",
Type:=2)

It assumes date is in DD/MM/YY (UK) format whereas I am assuming yours is US
format (mm/dd/yy)!

You need to convert to use US format.

' dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy", Type:=2)
Dim mmyy As String
mmyy = Application.InputBox(prompt:="Input Date as mm/yy", Type:=2)
dt = Left(mmyy, 2) & "/01/" & Right(mmyy, 2) '<== US format

(The sooner we standardise on date formats the better!)

HTH


[email protected] said:
Hello Toppers,

Thank you for you for your help! This is the part of the code that has
changed and how I inserted the new code into current code:

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)

' ==> new code ....
dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy",
Type:=2)
If Not IsDate(dt) Then
MsgBox "Invalid date"
Exit Sub
End If
yr = Year(dt)
StartDate = DateSerial(yr, Month(dt), 1)
EndDate = DateSerial(yr, Month(dt) + 1, 0)
'<==== End new code

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 = Month(dt) To Month(dt)
'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

Thank you,
James Cooper


Toppers wrote:
James,
I (re) tried the code for date of "07/06" and it just produced
the calendar for July so I am not sure why you [only] got January. Perhaps
you can repost (that part of) the code that has changed.



:

Hello Toppers,

Thank you for your quick response and the code. When I inserted the
code into the calendar it only creates a worksheet for January. I've
tried different dates in the input box but it only creates a worksheet
for January. Would you have any ideas on how to fix this?

Thak you again for your help,
James Cooper


Toppers wrote:
Try these changes

With Worksheets("Settings_North")
dt = .Cells(2, 2).Value
yr = Year(dt)
nt = .Cells(2, 6).Value
' ==> new code ....
dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy", Type:=2)
If Not IsDate(dt) Then
MsgBox "Invalid date"
Exit Sub
End If
yr = Year(dt)
StartDate = DateSerial(yr, Month(dt), 1)
EndDate = DateSerial(yr, Month(dt) + 1, 0)
'<==== End new code
Set rng = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))

End With
.
.
.
For i = Month(dt) To Month(dt)

HTH

:

MS has already done it for you...
http://support.microsoft.com/kb/213795/en-us
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware


"James Cooper" <[email protected]>
wrote in message
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?
-snip-
Click to expand...
Click to expand...
Click to expand...
 
J

jamesfc30

Hello Toppers,

This is the an example of the way my data is in sheet "Settings_North":

Beginning with ROW A CELL 2 all cells are Formated General and has 228
CELLS of data. This is some of the data beginning with CELL 2 through
CELL 50.
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
CHICOPEE - Q
HODGES - Q
VIS ART - Q
LECONTE - Q
PEABODY - Q
BALDWIN - Q
MAIN LIB - Q
N CHILLER - Q
WADDELL - Q
LUSTRAT - Q
BUS SERV - Q
ACADEMIC - Q
GILBERT -M
ADMIN - Q
TERRELL - Q
LAW SCH - M
DEAN RUSK - M
CALDWELL - M
BUS ANN - Q
MOORE COL - Q
BROOKS - M
SANFORD - M
PRES HSE - M
LUCY COBB - M
TATE CNT - M
BOOKSTORE - M
LEARN CNT - M
FINE ARTS - M
PARK HALL - M
JOUR - M
REED - M
OGLETH-DN - M
OGLETH-HS - M
BOLTON - M
RUSSELL - M
BRUMBY - M
MYERS - M

Now ROW B Cell 2 begins the dates they are formatted DATE 3/14/1998
and has 228 cells of dates. The dates are arranged for workdays Monday
- Friday and skipping weekends. Besides the first 12 cells with dates
are holidays all other cover July, August, and September. Here are some
of the dates begining with Cell 2 through Cell 50.

1/2/2006
1/16/2006
5/29/2006
7/4/2006
9/4/2006
11/23/2006
11/24/2006
12/25/2006
12/26/2006
12/27/2006
12/28/2006
12/29/2006
7/3/2006
7/3/2006
7/3/2006
7/3/2006
7/3/2006
7/5/2006
7/5/2006
7/5/2006
7/5/2006
7/5/2006
7/6/2006
7/6/2006
7/6/2006
7/6/2006
7/6/2006
7/7/2006
7/7/2006
7/7/2006
7/7/2006
7/7/2006
7/10/2006
7/10/2006
7/10/2006
7/10/2006
7/11/2006
7/11/2006
7/11/2006
7/11/2006
7/12/2006
7/12/2006
7/12/2006
7/12/2006
7/13/2006
7/13/2006
7/13/2006
7/13/2006
7/14/2006

Is there a code to use for the data in the worksheet to be US format or
are they automatically US Format when I installed Excel on my computer?


Thank you for your help,
James Cooper
James,
Do you have (correct) data in the sheet "Settings_North" i.e.
is it US format? I received this error if there was no/incorrect data.

I was out all day yesterday so couldn't reply sooner.


[email protected] said:
Hello Toppers,

Thank you for the previous code! I changed the code to US format but
now I'm receiving this error message "Run-time error '9': Subscript out
of range" then when I click the debug button it highlights this part of
the script:

v(idex) = v(idex) & Chr(10) & cell.Value

I'll include the changed code below:

Option Explicit
Sub BuildCalendar_North()

'Need activeworkbook sheet named Settings_North:
'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
Dim mmyy As String
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)

' ==> new code (UK)....
'dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy",
Type:=2) '==> UK format
mmyy = Application.InputBox(prompt:="Input Date as mm/yy", Type:=2)
dt = Left(mmyy, 2) & "/01/" & Right(mmyy, 2) '<== US format
If Not IsDate(dt) Then
MsgBox "Invalid date"
Exit Sub
End If
yr = Year(dt)
StartDate = DateSerial(yr, Month(dt), 1)
EndDate = DateSerial(yr, Month(dt) + 1, 0)
'<==== End new code



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 = Month(dt) To Month(dt)
'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

If you need other information please let me know!

Thank you for your help,
James Cooper
James,
I think this is the culprit:

dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy",
Type:=2)

It assumes date is in DD/MM/YY (UK) format whereas I am assuming yours is US
format (mm/dd/yy)!

You need to convert to use US format.

' dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy", Type:=2)
Dim mmyy As String
mmyy = Application.InputBox(prompt:="Input Date as mm/yy", Type:=2)
dt = Left(mmyy, 2) & "/01/" & Right(mmyy, 2) '<== US format

(The sooner we standardise on date formats the better!)

HTH


:

Hello Toppers,

Thank you for you for your help! This is the part of the code that has
changed and how I inserted the new code into current code:

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)

' ==> new code ....
dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy",
Type:=2)
If Not IsDate(dt) Then
MsgBox "Invalid date"
Exit Sub
End If
yr = Year(dt)
StartDate = DateSerial(yr, Month(dt), 1)
EndDate = DateSerial(yr, Month(dt) + 1, 0)
'<==== End new code

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 = Month(dt) To Month(dt)
'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

Thank you,
James Cooper


Toppers wrote:
James,
I (re) tried the code for date of "07/06" and it just produced
the calendar for July so I am not sure why you [only] got January. Perhaps
you can repost (that part of) the code that has changed.



:

Hello Toppers,

Thank you for your quick response and the code. When I inserted the
code into the calendar it only creates a worksheet for January. I've
tried different dates in the input box but it only creates a worksheet
for January. Would you have any ideas on how to fix this?

Thak you again for your help,
James Cooper


Toppers wrote:
Try these changes

With Worksheets("Settings_North")
dt = .Cells(2, 2).Value
yr = Year(dt)
nt = .Cells(2, 6).Value
' ==> new code ....
dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy", Type:=2)
If Not IsDate(dt) Then
MsgBox "Invalid date"
Exit Sub
End If
yr = Year(dt)
StartDate = DateSerial(yr, Month(dt), 1)
EndDate = DateSerial(yr, Month(dt) + 1, 0)
'<==== End new code
Set rng = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))

End With
.
.
.
For i = Month(dt) To Month(dt)

HTH

:

MS has already done it for you...
http://support.microsoft.com/kb/213795/en-us
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware


"James Cooper" <[email protected]>
wrote in message
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?
-snip-
Click to expand...
Click to expand...
Click to expand...
 
T

Toppers

James,
Having looked at your data, I have changed the code. I
misunderstood in that I thought all the data would relate to July but I see
it covers the year. I have made changes to the area of code which actual
produces ("prints") the calendar. Testing it here in the UK (I had to
reformat the dates!) worked OK.

Your dates appeared to be a mixture of text and date formats as I obtained
some errors when converting so perhaps you need look at these.

Apologies for the mis-interpretation but I hope this is OK.

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
Dim mm As Integer
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
' ******new code
mm = Application.InputBox(prompt:="Input Month as mm", Type:=1)
' You colud add code to check mm is between 1 and 12 ....
StartDate = DateSerial(yr, mm, 1)
EndDate = DateSerial(yr, mm + 1, 0)
' ********end new code
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
[email protected] said:
Hello Toppers,

This is the an example of the way my data is in sheet "Settings_North":

Beginning with ROW A CELL 2 all cells are Formated General and has 228
CELLS of data. This is some of the data beginning with CELL 2 through
CELL 50.
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
CHICOPEE - Q
HODGES - Q
VIS ART - Q
LECONTE - Q
PEABODY - Q
BALDWIN - Q
MAIN LIB - Q
N CHILLER - Q
WADDELL - Q
LUSTRAT - Q
BUS SERV - Q
ACADEMIC - Q
GILBERT -M
ADMIN - Q
TERRELL - Q
LAW SCH - M
DEAN RUSK - M
CALDWELL - M
BUS ANN - Q
MOORE COL - Q
BROOKS - M
SANFORD - M
PRES HSE - M
LUCY COBB - M
TATE CNT - M
BOOKSTORE - M
LEARN CNT - M
FINE ARTS - M
PARK HALL - M
JOUR - M
REED - M
OGLETH-DN - M
OGLETH-HS - M
BOLTON - M
RUSSELL - M
BRUMBY - M
MYERS - M

Now ROW B Cell 2 begins the dates they are formatted DATE 3/14/1998
and has 228 cells of dates. The dates are arranged for workdays Monday
- Friday and skipping weekends. Besides the first 12 cells with dates
are holidays all other cover July, August, and September. Here are some
of the dates begining with Cell 2 through Cell 50.

1/2/2006
1/16/2006
5/29/2006
7/4/2006
9/4/2006
11/23/2006
11/24/2006
12/25/2006
12/26/2006
12/27/2006
12/28/2006
12/29/2006
7/3/2006
7/3/2006
7/3/2006
7/3/2006
7/3/2006
7/5/2006
7/5/2006
7/5/2006
7/5/2006
7/5/2006
7/6/2006
7/6/2006
7/6/2006
7/6/2006
7/6/2006
7/7/2006
7/7/2006
7/7/2006
7/7/2006
7/7/2006
7/10/2006
7/10/2006
7/10/2006
7/10/2006
7/11/2006
7/11/2006
7/11/2006
7/11/2006
7/12/2006
7/12/2006
7/12/2006
7/12/2006
7/13/2006
7/13/2006
7/13/2006
7/13/2006
7/14/2006

Is there a code to use for the data in the worksheet to be US format or
are they automatically US Format when I installed Excel on my computer?


Thank you for your help,
James Cooper
James,
Do you have (correct) data in the sheet "Settings_North" i.e.
is it US format? I received this error if there was no/incorrect data.

I was out all day yesterday so couldn't reply sooner.


[email protected] said:
Hello Toppers,

Thank you for the previous code! I changed the code to US format but
now I'm receiving this error message "Run-time error '9': Subscript out
of range" then when I click the debug button it highlights this part of
the script:

v(idex) = v(idex) & Chr(10) & cell.Value

I'll include the changed code below:

Option Explicit
Sub BuildCalendar_North()

'Need activeworkbook sheet named Settings_North:
'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
Dim mmyy As String
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)

' ==> new code (UK)....
'dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy",
Type:=2) '==> UK format
mmyy = Application.InputBox(prompt:="Input Date as mm/yy", Type:=2)
dt = Left(mmyy, 2) & "/01/" & Right(mmyy, 2) '<== US format
If Not IsDate(dt) Then
MsgBox "Invalid date"
Exit Sub
End If
yr = Year(dt)
StartDate = DateSerial(yr, Month(dt), 1)
EndDate = DateSerial(yr, Month(dt) + 1, 0)
'<==== End new code



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 = Month(dt) To Month(dt)
'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

If you need other information please let me know!

Thank you for your help,
James Cooper

Toppers wrote:
James,
I think this is the culprit:

dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy",
Type:=2)

It assumes date is in DD/MM/YY (UK) format whereas I am assuming yours is US
format (mm/dd/yy)!

You need to convert to use US format.

' dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy", Type:=2)
Dim mmyy As String
mmyy = Application.InputBox(prompt:="Input Date as mm/yy", Type:=2)
dt = Left(mmyy, 2) & "/01/" & Right(mmyy, 2) '<== US format

(The sooner we standardise on date formats the better!)

HTH


:

Hello Toppers,

Thank you for you for your help! This is the part of the code that has
changed and how I inserted the new code into current code:

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)

' ==> new code ....
dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy",
Type:=2)
If Not IsDate(dt) Then
MsgBox "Invalid date"
Exit Sub
End If
yr = Year(dt)
StartDate = DateSerial(yr, Month(dt), 1)
EndDate = DateSerial(yr, Month(dt) + 1, 0)
'<==== End new code

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
Click to expand...
Click to expand...
Click to expand...
 
J

jamesfc30

Toppers,

The code works great! Sorry about waiting so long to thank you for your
help!

Thank you,
James Cooper
James,
Having looked at your data, I have changed the code. I
misunderstood in that I thought all the data would relate to July but I see
it covers the year. I have made changes to the area of code which actual
produces ("prints") the calendar. Testing it here in the UK (I had to
reformat the dates!) worked OK.

Your dates appeared to be a mixture of text and date formats as I obtained
some errors when converting so perhaps you need look at these.

Apologies for the mis-interpretation but I hope this is OK.

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
Dim mm As Integer
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
' ******new code
mm = Application.InputBox(prompt:="Input Month as mm", Type:=1)
' You colud add code to check mm is between 1 and 12 ....
StartDate = DateSerial(yr, mm, 1)
EndDate = DateSerial(yr, mm + 1, 0)
' ********end new code
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
[email protected] said:
Hello Toppers,

This is the an example of the way my data is in sheet "Settings_North":

Beginning with ROW A CELL 2 all cells are Formated General and has 228
CELLS of data. This is some of the data beginning with CELL 2 through
CELL 50.
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
HOLIDAY
CHICOPEE - Q
HODGES - Q
VIS ART - Q
LECONTE - Q
PEABODY - Q
BALDWIN - Q
MAIN LIB - Q
N CHILLER - Q
WADDELL - Q
LUSTRAT - Q
BUS SERV - Q
ACADEMIC - Q
GILBERT -M
ADMIN - Q
TERRELL - Q
LAW SCH - M
DEAN RUSK - M
CALDWELL - M
BUS ANN - Q
MOORE COL - Q
BROOKS - M
SANFORD - M
PRES HSE - M
LUCY COBB - M
TATE CNT - M
BOOKSTORE - M
LEARN CNT - M
FINE ARTS - M
PARK HALL - M
JOUR - M
REED - M
OGLETH-DN - M
OGLETH-HS - M
BOLTON - M
RUSSELL - M
BRUMBY - M
MYERS - M

Now ROW B Cell 2 begins the dates they are formatted DATE 3/14/1998
and has 228 cells of dates. The dates are arranged for workdays Monday
- Friday and skipping weekends. Besides the first 12 cells with dates
are holidays all other cover July, August, and September. Here are some
of the dates begining with Cell 2 through Cell 50.

1/2/2006
1/16/2006
5/29/2006
7/4/2006
9/4/2006
11/23/2006
11/24/2006
12/25/2006
12/26/2006
12/27/2006
12/28/2006
12/29/2006
7/3/2006
7/3/2006
7/3/2006
7/3/2006
7/3/2006
7/5/2006
7/5/2006
7/5/2006
7/5/2006
7/5/2006
7/6/2006
7/6/2006
7/6/2006
7/6/2006
7/6/2006
7/7/2006
7/7/2006
7/7/2006
7/7/2006
7/7/2006
7/10/2006
7/10/2006
7/10/2006
7/10/2006
7/11/2006
7/11/2006
7/11/2006
7/11/2006
7/12/2006
7/12/2006
7/12/2006
7/12/2006
7/13/2006
7/13/2006
7/13/2006
7/13/2006
7/14/2006

Is there a code to use for the data in the worksheet to be US format or
are they automatically US Format when I installed Excel on my computer?


Thank you for your help,
James Cooper
James,
Do you have (correct) data in the sheet "Settings_North" i.e.
is it US format? I received this error if there was no/incorrect data.

I was out all day yesterday so couldn't reply sooner.


:

Hello Toppers,

Thank you for the previous code! I changed the code to US format but
now I'm receiving this error message "Run-time error '9': Subscript out
of range" then when I click the debug button it highlights this part of
the script:

v(idex) = v(idex) & Chr(10) & cell.Value

I'll include the changed code below:

Option Explicit
Sub BuildCalendar_North()

'Need activeworkbook sheet named Settings_North:
'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
Dim mmyy As String
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)

' ==> new code (UK)....
'dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy",
Type:=2) '==> UK format
mmyy = Application.InputBox(prompt:="Input Date as mm/yy", Type:=2)
dt = Left(mmyy, 2) & "/01/" & Right(mmyy, 2) '<== US format
If Not IsDate(dt) Then
MsgBox "Invalid date"
Exit Sub
End If
yr = Year(dt)
StartDate = DateSerial(yr, Month(dt), 1)
EndDate = DateSerial(yr, Month(dt) + 1, 0)
'<==== End new code



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 = Month(dt) To Month(dt)
'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

If you need other information please let me know!

Thank you for your help,
James Cooper

Toppers wrote:
James,
I think this is the culprit:

dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy",
Type:=2)

It assumes date is in DD/MM/YY (UK) format whereas I am assuming yours is US
format (mm/dd/yy)!

You need to convert to use US format.

' dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy", Type:=2)
Dim mmyy As String
mmyy = Application.InputBox(prompt:="Input Date as mm/yy", Type:=2)
dt = Left(mmyy, 2) & "/01/" & Right(mmyy, 2) '<== US format

(The sooner we standardise on date formats the better!)

HTH


:

Hello Toppers,

Thank you for you for your help! This is the part of the code that has
changed and how I inserted the new code into current code:

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)

' ==> new code ....
dt = "01/" & Application.InputBox(prompt:="Input Date as mm/yy",
Type:=2)
If Not IsDate(dt) Then
MsgBox "Invalid date"
Exit Sub
End If
yr = Year(dt)
StartDate = DateSerial(yr, Month(dt), 1)
EndDate = DateSerial(yr, Month(dt) + 1, 0)
'<==== End new code

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
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Calendar change month from multiple sheets to one sheet, Excel 2000 & 2003 0
VBA Export to PDF 0
help me to look the following code 2
VBA - (re-) Set a Table Style 2
Modify working code to expand the output. 5
Six columns randon no.'s no dupes 6
Word Macro for multiple searches, incl. in footnotes 2
Add code to paste data to next available row 7

Top