DH Templates

Excel code or programming? Need to input Excel spreadsheet data into Excel spreadsheet calendar?

If you're reading this, thank you! Hopefully you know a little more about Excel than I do... To give you a little background, I've downloaded a Microsoft template in order to create a calendar in Excel. Each month is it's own tab and in each tab, the days of the month are are set up in cells B4-H8. I also have a separate spreadsheet containing the events with dates (we'll call this the list). What I'm hoping to do is to modify a code/module I've found (below) that will take the list and input each event into it's respective date on the calendar. The code below appears to be setup for a calendar that lives on one tab, as opposed to twelve. Can anyone assist me in modifying it to work with the calendar I have, or create a new code that will work? Thanks so much!! ...................................................................................................................... In the "list", if column A contains the dates and column B contains the job name... In cell C1 enter: =IF(A1="","",DAY(A1)) In cell D1 enter: =IF(A1="","",sheetname(A1)) Copy cells D1 and E1 down as far as the list could ever go Right click a worksheet tab and select View Code to open the VBAProject window. Note the members of VBAProject and then select Insert > Module to add a new module to the project In the new module add the following code Public Function SheetName(MonYear As Date) As String SheetName = UCase$(Format$(MonYear, "mmm yyyy")) End Function Sub LoadList() Dim oRow, oSheet, oCell As Object, iRow As Long For Each oSheet In ThisWorkbook.Sheets If oSheet.Name <> "List" Then oSheet.Range("A5:G9").Clear oSheet.Range("A11:G15").Clear oSheet.Range("A17:G21").Clear oSheet.Range("A23:G27").Clear oSheet.Range("A29:G33").Clear oSheet.Range("A35:G39").Clear End If Next For Each oRow In Sheets("List").Rows: DoEvents If oRow.Cells(1) = "" Then Exit For Sheets(oRow.Cells(5).Text).Activate For Each oCell In Range("A4:G40").Cells: DoEvents If oCell = oRow.Cells(4) Then For iRow = 1 To 5 If Cells(oCell.Row + iRow, oCell.Column) = "" Then Cells(oCell.Row + iRow, oCell.Column) = _ oRow.Cells(3).Text + " " + oRow.Cells(2).Text Exit For End If Next Exit For End If Next Next End Sub Back in the workbook select Tools > Macro > Macros > Options and assign the letter L (upper case l) to the macro LoadList. Now each time you press Ctrl-Shift-l the list will reload.

Public Comments

1. 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