Project Management Templates

One Response

1. Cozmosis Says:
   April 24th, 2010 at 4:53 pm

   The code you gave assumes the calendar days are in A4:G4 and then rows 5 to 9 will get your events (up to 5 events per day) and the A10:G10 have more days and then rows 11 to 15 are empty etc,

   So your calendar days on each monthly sheet are in
   A4:G4
   A10:G10
   A16:G16
   A22:G22
   A28:G28
   A34:G34

   Each monthly calendar sheet is named JAN 2009, FEB 2009 etc…

   The code below will read each event from the "List" sheet and put them under the proper day in the proper monthly calendar sheet.

   You don’t have to use the formulas in columns C and D on the List sheet. The macro figures out the day and month from the dates in column A.

   Sub LoadList()
   Dim rListDate As Range, ws As Worksheet, rCell As Range
   Dim iRow As Long, sht As String
   ‘
   For Each ws In ThisWorkbook.Sheets
   If ws.Name <> "List" Then
   ws.Range("A5:G9").Clear
   ws.Range("A11:G15").ClearContents
   ws.Range("A17:G21").ClearContents
   ws.Range("A23:G27").ClearContents
   ws.Range("A29:G33").ClearContents
   ws.Range("A35:G39").ClearContents
   End If
   Next ws
   ‘
   For Each rListDate In Sheets("List").Range("A1", Sheets("List").[A1].End(xlDown))
   If IsDate(rListDate) Then
   sht = UCase(Format(rListDate, "mmm yyyy"))
   ‘ Check if calendar sheet exists for the event date
   On Error Resume Next
   If Sheets(sht).Name = "" Then
   On Error GoTo 0
   Sheets("List").Select
   rListDate.Select
   MsgBox "There is no calendar sheet for " & rListDate
   Else
   With Sheets(sht)
   For Each rCell In Union(.[A4:G4], .[A10:G10], .[A16:G16], .[A22:G22], .[A28:G28], .[A34:G34])
   If rCell = Day(rListDate) Then
   If Not IsEmpty(rCell.Offset(5, 0)) Then
   Sheets(sht).Select
   rCell.Select
   MsgBox sht & vbCr & "Day " & Day(rListDate) & " is full."
   Else
   For iRow = 1 To 5
   If IsEmpty(rCell.Offset(iRow, 0)) Then
   rCell.Offset(iRow, 0) = Day(rListDate) & " " & rListDate.Offset(0, 1).Text
   Exit For
   End If: Next iRow: End If: End If: Next rCell: End With: End If: End If: Next rListDate
   End Sub
   References :

Leave a Comment

Name

Mail (will not be published)

Website

Please note: Comment moderation is enabled and may delay your comment. There is no need to resubmit your comment.