View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default Convert listing of events with dates to calendar - Pls help

Assumes you have a sheet in the activeworkbook with the name Event List
the first event name is in A2 and the date is in B2 and so forth down the
column with no breaks or interruptions. this should get you started.

Option Explicit
Sub BuildCalendar()
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

With Worksheets("Event List")
dt = .Cells(2, 2).Value
yr = Year(dt)
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 sh, yr, v
End If
Next
End Sub


Sub MakeCalendar(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
sh.Range("A:G").EntireColumn.ColumnWidth = 22
sh.Rows(1).RowHeight = 35
With sh.Cells(1, 1).Resize(1, 7)
.HorizontalAlignment = 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 = 35
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 = 18
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 = xlGeneral
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 = 50
End Sub

--
Regards,
Tom Ogilvy

"jennifer" wrote in message
...
yes these are 3 separate events that need to appear on the calendar. I

can
work on abbreviations but still need help on how to convert the list and
create separate worksheets in a calendar format for the 12 months.

Thanks!

"Tom Ogilvy" wrote:

I am sure you could using a macro

Seminar, Posting and End are 3 different events?

One challenge would be fitting the information within the "box" which

would
depend on the length of the text describing the event and the number of
events which might occur for 1 box (date).

--
Regards,
Tom Ogilvy

"jennifer" wrote in message
...
Is there a way to convert a table that lists events with dates to a

calendar
format? For example, I have

Event Date
Seminar 4/15/2005
Posting 5/4/2005
End 7/20/2005

I would then have individual sheets for the months with the items

above in
the appropriate boxes in the month calendar. Any help would be

appreciated!