Monthly Event Schedule (format like that)

Originally Posted by mikerickson

I'm not entirely clear what you want. i.e. I don't know which sheet you envision as the input sheet, Master or the month sheet.

What I've done in the attached is:
1) change the merged cells to CenterAcrossSelection
2) create a dynamic named range DataRange of the data on Master Plan
3) Put the UDF, EventForDay in the cells of January 2010.
EventForDay(dateSought, dataRange, columnsReturned1, columnsReturned2,..)
Will search the top row of the dataRange to find the dateSought, then, for each non-empty cell in the found column, an event string will be created with the data in the columns indicated by the columnsReturned arguments. These event strings will then be sorted by start time and concatenated into a string desribing all of that day's events.

=EventForDay(Date(2010, 1, 4),dataRange, 2, 1)
will create event strings from the first and fourth columns (Event, Person in Charge) of dataRange.

the formula in your case is =EventsForDay(E3,DataRange,1,2,"time",3,4)

Function EventsForDay(dateSought As Double, dataRange As Range, ParamArray columnsReturned() As Variant) As String
    Dim HeadersArray As Variant
    Dim halfDayEvents As String, fullDayEvents As String
    Dim oneEventString As String, eventDelimiter As String: eventDelimiter = vbCr
    Dim rangeToSearch As Range
    Dim i As Long, oneCell As Range, testLen As Long
    Dim resultstr As String
    
    On Error GoTo Halt
    With dataRange.Rows(1)
        With .Cells(1, Application.Match(dateSought, .Cells, 0)).EntireColumn
            Set rangeToSearch = Application.Intersect(dataRange, .Cells)
        End With
    End With
    Set rangeToSearch = Application.Intersect(rangeToSearch, rangeToSearch.Offset(1, 0))
    On Error GoTo 0
    
    HeadersArray = columnsReturned
    For i = LBound(columnsReturned) To UBound(columnsReturned)
        If columnsReturned(i) = "time" Then
            HeadersArray(i) = "Time: "
        Else
            HeadersArray(i) = CStr(dataRange.Cells(1, columnsReturned(i)).Value) & ": "
        End If
    Next i
    
    For Each oneCell In rangeToSearch
        With oneCell
            If .Value <> vbNullString Then
            Rem if there is an event, make string describing it
            oneEventString = vbNullString
            For i = LBound(columnsReturned) To UBound(columnsReturned)
                If HeadersArray(i) = "Time: " Then
                    oneEventString = oneEventString & _
                                                    HeadersArray(i)
                                                    
                    Select Case LCase(CStr(.Value))
                        Case "am"
                            oneEventString = oneEventString & _
                                                    "8:30 - 12:00" _
                                                    & vbCr
                        Case "pm"
                            oneEventString = oneEventString & _
                                                    "13:30 - 17:00" _
                                                    & vbCr
                        Case Else
                            oneEventString = oneEventString & _
                                                    "8:30 - 17:00" _
                                                    & vbCr
                    End Select
                Else
                    With .EntireRow
                        oneEventString = oneEventString & _
                                                    HeadersArray(i) & _
                                                    CStr(Application.Intersect(.Cells, dataRange.Columns(columnsReturned(i))).Value) _
                                                    & vbCr
                                                   
                    End With
                End If
            Next i
                If oneEventString <> vbNullString Then
                    Select Case CStr(.Value)
                        Case "AM"
                            halfDayEvents = eventDelimiter & oneEventString & halfDayEvents
                        Case "PM"
                            halfDayEvents = halfDayEvents & eventDelimiter & oneEventString
                        Case Else
                            fullDayEvents = eventDelimiter & oneEventString & fullDayEvents
                    End Select
                End If
            End If
        End With
    Next oneCell
    fullDayEvents = Mid(fullDayEvents, Len(eventDelimiter) + 1)
    
    halfDayEvents = Mid(halfDayEvents, Len(eventDelimiter) + 1)
    halfDayEvents = fullDayEvents & eventDelimiter & halfDayEvents
    
    If Left(halfDayEvents, Len(eventDelimiter)) = eventDelimiter Then
        halfDayEvents = Mid(halfDayEvents, Len(eventDelimiter) + 1)
    End If
    EventsForDay = halfDayEvents
Exit Function
Halt:
If Err Then EventsForDay = vbNullString
On Error GoTo 0
End Function

Hi Mike,

That's great. My intention is Master_Plan is input sheet where user puts yearly events and then he/she creates monthly sheets (named January 2010, February 2010,...), and then Excel automatically fills necessary info in those sheets.

Just wonder this UDF can work in Excel 2007. I will try.

Thank you so much.