Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Modify Yearly Calendar to Monthly Calendar Excel 2000?
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Modify Yearly Calendar to Monthly Calendar Excel 2000?
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- |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Modify Yearly Calendar to Monthly Calendar Excel 2000?
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- |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Modify Yearly Calendar to Monthly Calendar Excel 2000?
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- |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Modify Yearly Calendar to Monthly Calendar Excel 2000?
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 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- |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Modify Yearly Calendar to Monthly Calendar Excel 2000?
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 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 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- |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Modify Yearly Calendar to Monthly Calendar Excel 2000?
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- |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Modify Yearly Calendar to Monthly Calendar Excel 2000?
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- |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Modify Yearly Calendar to Monthly Calendar Excel 2000?
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- |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Modify Yearly Calendar to Monthly Calendar Excel 2000?
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- |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
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- |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
Modify Yearly Calendar to Monthly Calendar Excel 2000?
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 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- |
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
Modify Yearly Calendar to Monthly Calendar Excel 2000?
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 |
#14
Posted to microsoft.public.excel.programming
|
|||
|
|||
Modify Yearly Calendar to Monthly Calendar Excel 2000?
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
monthly tabs missing in yearly calendar | Excel Discussion (Misc queries) | |||
yearly calendar | Excel Discussion (Misc queries) | |||
Adding a yearly calendar to excel spreadsheet | Excel Worksheet Functions | |||
automate calendar dates on worksheets to make a yearly planner | Excel Discussion (Misc queries) | |||
Monthly calendar in EXCEL? | Excel Discussion (Misc queries) |