View Single Post
  #11   Report Post  
Posted to microsoft.public.excel.programming
Toppers Toppers is offline
external usenet poster
 
Posts: 4,339
Default Modify Yearly Calendar to Monthly Calendar Excel 2000?

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.


" wrote:

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


" wrote:

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.



" wrote:

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

"Jim Cone" wrote:

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"
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-