Toppers,

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

Thank you,
James Cooper

Toppers wrote:
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
" wrote:

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

Toppers wrote:
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