I need to create a macro, but unsure of what formulas to put into it

[lovevegeta]

Hello,

I am working with excel 2013 and it has been quite some time since I created a macro so I am extremely rusty.

What I am trying to do:

Input data onto Sheet1 from a csv file that I can then use to separate onto different sheets, where the name is only transferred to one sheet. Basically, I have a school of children that will be filling out a google form with the top 3 choices of what they want to do for an event. I want to put that google form data into the first sheet, then have the macro, when started, filter the students into different sheets (which represents the activities) descending down the list deleting each student as they are placed onto a specific sheet. Only thing is I need to create a limit to how many names can go onto each sheet. I put a limit in the VBA to how many rows it could go down, I just don't know if a macro that is looping acknowledges this. Also, if the student's 1st choice is filled, how do I get it to go to the 2nd choice and put it on that sheet? Then continue that and place them in their 3rd choice is the first 2 are filled?

I have attached a generic excel outline that has the basics of what I am trying to work with, any input, help, advice would be so greatly appreciated! Sorting 550 students by hand just gets a little crazy and trying to streamline our events would really help this teacher out!

[SamT]

Some "What Ifs" and other questions:



Some Team activities require a fixed number of members, ie Basketball needs units of 10 students (2 x 5 member teams)
Some activities require a minimum number of students. You won't want to send 1 kid to a movie alone.
How will you prioritize assigning students? Alphabetically? Grade Score? Grade level/Age? Randomly?
Will there be any sex discrimination? (example:No girls on boys Basketball Teams?) (5 boys and 1 girl want Basketball... Select randomly or by sex? - Note that this would require a much higher level of programming at this specific level.


I am thinking of a Master Workbook that imports the CSV, does all the sorting and assigning, then produces a separate workbook with all the activities and student assignments. For ease of coding and maintenance, I suggest a Masterbook layout similar to the attached.

[Paul_Hossler]

I didn't want to over think this

I added a 'Capacity' WS with number of students per site and number of sites per activity since your Movie 1 -- Movie 6 seem to be different sites for the same activity

It uses a Working sheet (temporarily not deleted at the end) to assign names using their 1, 2 or 3 priority activity

There's a lot more you can do with this (error checking, formatting, etc.)



Option Explicit
Dim wsNames As Worksheet, wsCapacity As Worksheet
Dim rName As Range, rCapacity As Range

Sub PlaceStudents()
Dim iName As Long, iCapacity As Long, i As Long, iChoice As Long, iLimit As Long
Dim sName As String, sActivity As String
Dim collLimit As Collection


'init
Set wsNames = Worksheets("Names")
wsNames.Cells(1, 1).CurrentRegion.Interior.ColorIndex = xlColorIndexNone
Set wsCapacity = Worksheets("Capacity")
Set rCapacity = wsCapacity.Cells(1, 1).CurrentRegion
ReDim aLimit(1 To rCapacity.Rows.Count)


'make working copy
Call pvtDeleteSheet("Working Names")
wsNames.Copy after:=wsNames
ActiveSheet.Name = "Working Names"
Set wsNames = Worksheets("Working Names")


'stack activities
With wsNames
'names
Set rName = Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))
rName.Copy .Cells(2, 1).End(xlDown).Offset(1, 0)
rName.Copy .Cells(2, 1).End(xlDown).Offset(1, 0)
'names and activty 3
Range(.Cells(2, 3), .Cells(2, 3).End(xlDown)).Copy .Cells(2, 2).End(xlDown).Offset(1, 0)
Range(.Cells(2, 4), .Cells(2, 4).End(xlDown)).Copy .Cells(2, 2).End(xlDown).Offset(1, 0)

.Columns(4).ClearContents
.Columns(3).ClearContents

.Cells(1, 3).Value = "Assigned"
End With


'add sheets
With wsCapacity
For iCapacity = 2 To .Cells(1, 1).CurrentRegion.Rows.Count

'some have more than one
For i = 1 To pvtSites(.Cells(iCapacity, 1).Value)
If pvtSites(.Cells(iCapacity, 1).Value) = 1 Then
sActivity = .Cells(iCapacity, 1).Value
Else
sActivity = .Cells(iCapacity, 1).Value & " " & i
End If

'delete if exists
Call pvtDeleteSheet(sActivity)

Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = sActivity
ActiveSheet.Cells(1, 1).Value = "Name"

Next i

Next iCapacity
End With

'fill limit collection
Set collLimit = New Collection
For iChoice = 2 To wsCapacity.Cells(1, 1).CurrentRegion.Rows.Count
sActivity = wsCapacity.Cells(iChoice, 1).Value
collLimit.Add pvtCapacity(sActivity) * pvtSites(sActivity), sActivity
Next iChoice


With wsNames
'assign names to activity
For iName = 2 To .Cells(1, 1).CurrentRegion.Rows.Count

sName = .Cells(iName, 1).Value
sActivity = .Cells(iName, 2).Value

'blank = no more openings or already has activity
If Len(sActivity) = 0 Then GoTo NextName

'assign
iLimit = collLimit(sActivity)
.Cells(iName, 3).Value = iLimit
collLimit.Remove sActivity
collLimit.Add iLimit - 1, sActivity

'assigned, so clear remaining requests
For i = iName + 1 To .Cells(1, 1).CurrentRegion.Rows.Count
If .Cells(i, 1).Value = sName Then .Cells(i, 2).ClearContents
Next i

'no more openings
If collLimit(sActivity) = 0 Then
For i = iName + 1 To .Cells(1, 1).CurrentRegion.Rows.Count
If .Cells(i, 2).Value = sActivity Then .Cells(i, 2).ClearContents
Next i
End If
NextName:
Next iName
End With

'put on sheets
With wsNames
For iName = 2 To .Cells(1, 1).CurrentRegion.Rows.Count

sName = .Cells(iName, 1).Value
sActivity = .Cells(iName, 2).Value

'not assigned
If Len(sActivity) = 0 Then GoTo NextName2

If pvtSites(sActivity) = 1 Then
Worksheets(sActivity).Cells(Worksheets(sActivity).Rows.Count, 1).End(xlUp).Offset(1, 0).Value = sName
Else
For i = 1 To pvtSites(sActivity)
If Worksheets(sActivity & " " & i).Cells(1, 1).CurrentRegion.Count - 1 < pvtCapacity(sActivity) Then
'room on this sheet
Worksheets(sActivity & " " & i).Cells(Worksheets(sActivity & " " & i).Rows.Count, 1).End(xlUp).Offset(1, 0).Value = sName
Exit For
End If
Next i
End If
NextName2:
Next iName
End With

'remove working copy
' Call pvtDeleteSheet(wsNames.Name)
End Sub

Private Sub pvtDeleteSheet(s As String)
'remove working copy
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(s).Delete
Application.DisplayAlerts = True
On Error GoTo 0
End Sub

Private Function pvtCapacity(s As String) As Long
pvtCapacity = 0
On Error Resume Next
pvtCapacity = Application.WorksheetFunction.VLookup(s, rCapacity, 2, False)
On Error GoTo 0
End Function


Private Function pvtSites(s As String) As Long
pvtSites = 0
On Error Resume Next
pvtSites = Application.WorksheetFunction.VLookup(s, rCapacity, 3, False)
On Error GoTo 0
End Function

[p45cal]

Well, I started to code for this and then Paul posted his solution, which was more comprehensive than my offering.
I attach my offering, three-quarters finished, just if anyone's interested. Click the button in the Data Sheet sheet. The logic behind mine and Paul's code is actually quite similar.
Things I chose to include were

the introduction of some randomness, so each run is likely to end differently
the removal of duplicate activities for the same child - in such a way that if he/she duplicates an entry in the hope of being surer that they'll get to go on it, the duplicates are removed to leave the lowest priority only. If they're told this, it may curb that behaviour!
the preference level for each person/activity pair

To introduce some randomness into Paul's great solution you could try replacing:
'stack activities
With wsNames
'names
Set rName = Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))
rName.Copy .Cells(2, 1).End(xlDown).Offset(1, 0)
rName.Copy .Cells(2, 1).End(xlDown).Offset(1, 0)
'names and activty 3
Range(.Cells(2, 3), .Cells(2, 3).End(xlDown)).Copy .Cells(2, 2).End(xlDown).Offset(1, 0)
Range(.Cells(2, 4), .Cells(2, 4).End(xlDown)).Copy .Cells(2, 2).End(xlDown).Offset(1, 0)

.Columns(4).ClearContents
.Columns(3).ClearContents

.Cells(1, 3).Value = "Assigned"
End Withwith:

'stack activities
With wsNames
'names
Set rName = Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))
rName.Offset(, 4).FormulaR1C1 = "=RAND()"
rName.Resize(, 5).Sort key1:=rName.Offset(, 4), Header:=xlNo
.Sort.Header = xlNo
Union(rName, rName.Offset(, 2)).Copy .Cells(2, 1).End(xlDown).Offset(1, 0)
.Sort.Apply
Union(rName, rName.Offset(, 3)).Copy .Cells(2, 1).End(xlDown).Offset(1, 0)
.Sort.Apply 'for top section to be in a different order from last section
.Columns(3).Resize(, 3).ClearContents
.Cells(1, 3).Value = "Assigned"
End With


SamT's got some interesting points about minimum numbers - quite a challenge to cope with!
The point about sex discrimination though is easy to solve; in this day of enforced gender fluidity on society, you merely need to encourage said children to identify themselves with the appropriate gender for the day.
I was accompanying someone to an outpatients department in a UK hospital and caught sight of the questionnaire he she they were being asked to fill out, among the questions was:
What gender do you indentify yourself with today?

[lovevegeta]

Thank you, I don't think we would need a minimum as there are only 5 different activities and 550 students to be separated into them. I do have a maximum number of students who can go, but that is the only limitation. Teams are made by the teachers in charge of the event and there is not any sex discrimination.

[lovevegeta]

Thank you! This is very helpful! So appreciated and combined with p45cal duplicate activities to be removed (huge problem, the students really love dodgeball and its limited space) it should work out well! Thank you and everyone for their help!