PDA

View Full Version : [SOLVED] Automate Lookup Function to create participant schedules



m-pe
05-14-2017, 01:00 PM
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
05-14-2017, 02:25 PM
Where do the days and times for the schedule come from, and what happens to choice 2?

m-pe
05-14-2017, 03:14 PM
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
05-20-2017, 11:04 AM
Does anyone have any suggestions?

mdmackillop
05-20-2017, 03:53 PM
Note: Ref column added to Data sheet

m-pe
05-20-2017, 06:58 PM
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
05-21-2017, 04:48 AM
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
05-21-2017, 02:41 PM
Thank you so much. You have been so helpful :)