Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 121
Default Calendar change month from multiple sheets to one sheet, Excel 2000 & 2003

Hello,

I have a calendar that puts each month on a separate worksheet within
the same workbook. How can the vba code be changed so that I can select
one month and it will be on one worksheet. Then when I select another
month it will be on the same worksheet but it clears the other month
off? Also, I need to be able to change the year.

VBA Calendar Code:

Option Explicit

Sub DeleteSheets_North()

Dim Sht As Worksheet

For Each Sht In ThisWorkbook.Worksheets
Application.DisplayAlerts = False
'Reads characters left to right(begin at end count
backwards)
If Right(Sht.Name, 5) = "NORTH" Then
Sht.Delete
Application.DisplayAlerts = True
End If
Next Sht
'Run Macro Below
BuildCalendar_North
End Sub

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)

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
'Run Macro
BackButton
'Sheet Name
Sh.Name = [A1] & " " & [G1]
End If
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, 4).Value = Sheets("Settings_North").Range("F3").Value
Sh.Cells(1, 4).Font.Bold = True
Sh.Cells(1, 4).Font.Size = 18
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,
jfcby

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Excel 2003 month to month data change grid Chad[_2_] Excel Discussion (Misc queries) 2 February 15th 08 02:36 AM
Pivot Table with multiple sheets in Excel 2000 Joël Excel Discussion (Misc queries) 1 October 16th 07 06:07 PM
Modify Yearly Calendar to Monthly Calendar Excel 2000? James Cooper Excel Programming 13 July 13th 06 11:46 PM
Change in Link Behavior - Excel 2000 to 2003 David G. Hoch Links and Linking in Excel 0 April 27th 06 04:41 AM
Calendar Control in Excel 2000 can't display date in Excel 2003? Lewis Excel Discussion (Misc queries) 0 April 21st 06 05:07 PM


All times are GMT +1. The time now is 03:33 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"