Automate Lookup Function to create participant schedules

[m-pe]

Hi,

I am trying to create individual participant schedules. I have created a sample excel file that shows what I want to do. My actual file has 150 registrations, and many more session times.

The registration data for each participant is shown in a separate row. Participants have indicated their top choice with a 1. Each group of 5 columns (ie. T1-H1, T2-H1, T3-H1, T4-H1, T5-H1) is one time slot and the participant will have a 1 in only one of the columns in this group.

The schedule tab shows the sample participant schedule. I have used the Lookup function to pull the data to give an example of what I want to do. It looks up their first choice for each time slot, and based on that choice, it fills in the room number where the session is delivered, as well as the name of the session.

I need to create a separate schedule for each participant, and do not want to have to do this manually 150 times.




Thank you for your suggestions.

[Bob Phillips]

Where do the days and times for the schedule come from, and what happens to choice 2?

[m-pe]

Where do the days and times for the schedule come from, and what happens to choice 2?

I had intended to just type the days and times into the participant schedule, but I could put them into a separate sheet. Basically I have sessions Tuesday-Thursday at 830, 1030, 1pm and 3pm.

Right now, we did not reach capacity on our sessions, so people can have their first choice.

[m-pe]

Does anyone have any suggestions?

[mdmackillop]

Note: Ref column added to Data sheet

[m-pe]

Thank you mdmckillop. That is very helpful. I have modified the code to take into consideration all of my session times.

1. I am however having a small issue - I can resolve it by deleting all of the second choices indicated in the registration data, but I am wondering if you might know why it is sometimes choosing the second participant's second choice to display in the schedule.

2. Is there a way to tell it to bold the Session Name heading, and the Room heading in each schedule. I added the font.bold=true to the Participant Schedule heading, but it doesn't seem to work for the Session name and Room headings.

Here is my modified code:

Sub Schedule()
Dim Rng As Range
    With Sheets("Schedule")
        .Cells.ClearContents
        .ResetAllPageBreaks
    End With
    
    Set Rng = Sheets("Raw Data").Cells(1, 1).CurrentRegion
    For i = 1 To 150
        rw = i + 1
        Set cel = Rng.Cells(i + 1, 1)
        If cel = "" Then GoTo Exits
        With Sheets("Schedule")
            Set c = .Cells(1 + (i - 1) * 16, 1)
            If c.Row > 1 Then ActiveSheet.HPageBreaks.Add before:=Range(c.Address)
        End With
        With c
            .Formula = "Personal Schedule"
            .Font.Bold = True
            .Offset(, 2) = cel.Offset(, 3).Value
            .Offset(2, 2).Formula = "Session Name"
            .Offset(2, 3).Formula = "Room"
            
            'Tuesday - 1030am
            .Offset(3, 2).Formula = "=LOOKUP(" & i & ",'Raw Data'!E" & rw & ":I" & rw & ",'Raw Data'!E1:I1)"
            .Offset(3, 3).Formula = "=(VLOOKUP(C" & c.Row + 3 & ",'Room Numbers'!A2:B56,2,0))"
            
            'Tuesday - 1pm
            .Offset(4, 2).Formula = "=LOOKUP(" & i & ",'Raw Data'!J" & rw & ":N" & rw & ",'Raw Data'!J1:N1)"
            .Offset(4, 3).Formula = "=(VLOOKUP(C" & c.Row + 4 & ",'Room Numbers'!A2:B56,2,0))"
            
            'Tuesday - 3pm
            .Offset(5, 2).Formula = "=LOOKUP(" & i & ",'Raw Data'!O" & rw & ":S" & rw & ",'Raw Data'!O1:S1)"
            .Offset(5, 3).Formula = "=(VLOOKUP(C" & c.Row + 5 & ",'Room Numbers'!A2:B56,2,0))"
            
            'Wednesday - 830am
            .Offset(6, 2).Formula = "=LOOKUP(" & i & ",'Raw Data'!T" & rw & ":X" & rw & ",'Raw Data'!T1:X1)"
            .Offset(6, 3).Formula = "=(VLOOKUP(C" & c.Row + 6 & ",'Room Numbers'!A2:B56,2,0))"
            
            'Wednesday - 1030am
            .Offset(7, 2).Formula = "=LOOKUP(" & i & ",'Raw Data'!Y" & rw & ":AC" & rw & ",'Raw Data'!Y1:AC1)"
            .Offset(7, 3).Formula = "=(VLOOKUP(C" & c.Row + 7 & ",'Room Numbers'!A2:B56,2,0))"
            
            'Wednesday - 1pm
            .Offset(8, 2).Formula = "=LOOKUP(" & i & ",'Raw Data'!AD" & rw & ":AH" & rw & ",'Raw Data'!AD1:AH1)"
            .Offset(8, 3).Formula = "=(VLOOKUP(C" & c.Row + 8 & ",'Room Numbers'!A2:B56,2,0))"
            
            'Wednesday - 3pm
            .Offset(9, 2).Formula = "=LOOKUP(" & i & ",'Raw Data'!AI" & rw & ":AM" & rw & ",'Raw Data'!AI1:AM1)"
            .Offset(9, 3).Formula = "=(VLOOKUP(C" & c.Row + 9 & ",'Room Numbers'!A2:B56,2,0))"
            
            'Thursday - 830am
            .Offset(10, 2).Formula = "=LOOKUP(" & i & ",'Raw Data'!AN" & rw & ":AR" & rw & ",'Raw Data'!AN1:AR1)"
            .Offset(10, 3).Formula = "=(VLOOKUP(C" & c.Row + 10 & ",'Room Numbers'!A2:B56,2,0))"
            
            'Thursday - 1030am
            .Offset(11, 2).Formula = "=LOOKUP(" & i & ",'Raw Data'!AS" & rw & ":AW" & rw & ",'Raw Data'!AS1:AW1)"
            .Offset(11, 3).Formula = "=(VLOOKUP(C" & c.Row + 11 & ",'Room Numbers'!A2:B56,2,0))"
            
            'Thursday - 1pm
            .Offset(12, 2).Formula = "=LOOKUP(" & i & ",'Raw Data'!AX" & rw & ":BB" & rw & ",'Raw Data'!AX1:BB1)"
            .Offset(12, 3).Formula = "=(VLOOKUP(C" & c.Row + 12 & ",'Room Numbers'!A2:B56,2,0))"
            
            'Thursday - 3pm
            .Offset(13, 2).Formula = "=LOOKUP(" & i & ",'Raw Data'!BC" & rw & ":BG" & rw & ",'Raw Data'!BC1:BG1)"
            .Offset(13, 3).Formula = "=(VLOOKUP(C" & c.Row + 13 & ",'Room Numbers'!A2:B56,2,0))"
            
        End With
    Next i
Exits:
    ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
End Sub

[mdmackillop]

Lookup is unreliable. Changed to Index/Match

Option Explicit
    Dim Sched As Range
    Dim rw As Long
    Dim c As Range
    
Sub Schedule2()
    Dim Rng As Range, cel As Range
    Dim i As Long, j As Long
    With Sheets("Schedule")
        .Cells.ClearContents
        .ResetAllPageBreaks
    End With
    Application.ScreenUpdating = False
     
    Set Rng = Sheets("Raw Data").Cells(1, 1).CurrentRegion
    Set Sched = Sheets("Raw Data").Cells(1, 5).Resize(, 5)
    
    For i = 1 To 150
        rw = i + 1
        Set cel = Rng.Cells(i + 1, 1)
        If cel = "" Then GoTo Exits
        With Sheets("Schedule")
            Set c = .Cells(1 + (i - 1) * 16, 1)
            If c.Row > 1 Then ActiveSheet.HPageBreaks.Add before:=Range(c.Address)
        End With
        With c
            .Formula = "Personal Schedule"
            .Font.Bold = True
            .Offset(, 2) = cel.Offset(, 3).Value
            With .Offset(2, 2).Resize(, 2)
                .Formula = Array("Session Name", "Room")
                .Font.Bold = True
            End With
            For j = 0 To 9
                .Offset(3 + j, 2).Formula = Schedule(j)
                .Offset(3 + j, 3).Formula = Room(j)
            Next j
        End With
    Next i
Exits:
    ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
    Application.ScreenUpdating = True
End Sub


Function Schedule(oset) As String
    Schedule = "=INDEX('Raw Data'!" & Sched.Offset(, oset * 5).Address & ",MATCH(1,'Raw Data'!" & Sched.Offset(rw - 1, oset * 5).Address & ",0))"
End Function


Function Room(oset) As String
    Room = "=(VLOOKUP(C" & c.Row + oset + 3 & ",'Room Numbers'!A2:B56,2,0))"
End Function

[m-pe]

Thank you so much. You have been so helpful