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 With

with:

'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!