Assign Name to a group (VBA)

rpaulson · Oct 20, 2023

I have a list of people name in column A. starting in cell A1 ,There is anywhere from 10 to 100 names on the list.

I need to assign these people to a class room number (Room A, B, C .....) there may be up to 9 rooms available on any given day.

I am looking for VBA code to assign the people into a room. by putting the room number in column B

I will use:

people= Cells(Rows.Count, "A").End(xlUp).Row 'this will tell me how many people are registered
rooms= inputbox ("How many rooms are available today") 'number of groups to break the list into

I know i could go Down the list and write A,B,C,D then A,B,C,D then A,B,C,D etc... but that is not what i want.
i want the list to go A,A,A,A B,B,B,B, C,C,C,C D,D,D,D, .....

Examples.

43 people and 5 rooms - Room A would have the first 9 people on the list, Room B the next 9, Room C the next 9, Room D then next 8 and Room E the last 8
17 people and 3 rooms - Room A would have the first 6 people on the list, Room B the next 6, Room C the last 5.
49 people and 4 rooms - A would have first 13, B next 12, C next 12, and D last 12

thanks for looking,
-Ross

rpaulson · Oct 21, 2023

Jeffrey Mahoney said:

A little more complexity, but I think it gets you there.

VBA Code:

Sub AssignRoom()
  Dim R As Range
  Dim Cel As Range
  Dim Tot As Long
  Dim Div As Long
  Dim Cnt As Long
  Dim Rooms As Long
  Dim RmCnt As Long
  Dim RmLetters As String
  Dim RmLtr As String
  Dim Rmndr As Long
  Dim DivTemp As Long
 
  RmLetters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 
  Set R = Range(Range("A1"), Range("A1").End(xlDown))
  Tot = R.Rows.Count
  Rooms = InputBox("Please enter the number of rooms", "Room Number")
  'Rooms = Range("E1").Value
  Div = Int(Tot / Rooms)
  Rmndr = Tot Mod Rooms
 
  If Rooms > 26 Then
    MsgBox "There can only be 26 rooms"
    Exit Sub
  End If
 
  RmCnt = 1
  If Rmndr > 0 Then
    DivTemp = Div + 1
    Rmndr = Rmndr - 1
  Else
    DivTemp = Div
  End If
  For Each Cel In R
    Cnt = Cnt + 1
    If Cnt > DivTemp Then
      RmCnt = RmCnt + 1
      Cnt = 1
      If Rmndr > 0 Then
        DivTemp = Div + 1
        Rmndr = Rmndr - 1
      Else
        DivTemp = Div
      End If
    End If
    RmLtr = Mid(RmLetters, RmCnt, 1)
    Cel.Offset(0, 1) = RmLtr
  Next Cel

End Sub

I went with This code.
Thanks Jeff

Herakles · Oct 21, 2023

Another fun option based to some extent upon the work by jolivanes in Post #10 this is called from a cell and acts similar to a SPILL formula.

It will only work if you have the TEXTSPLIT function on your Excel version.

This is the cell formula.
A call to the fncAssignNameToAGroup function wrapped in the Excel TEXTSPLIT function
=TEXTSPLIT(fncAssignNameToAGroup(B2:B43,A2:A201,TRUE),",","**",TRUE)

It depends on two ranges, one containing the room names and one containing the names of the occupants and a boolean indicating
whether you want the Occupant first (TRUE) or Room Name first (FALSE).

Assign Name to a group.xlsm

A

B

C

D

E

F

G

H

1

Name

Rooms

Occupant

Room

Occupant

2

Name 1

Room 1

Name 1

Room 1

Name 1

3

Name 2

Room 2

Name 2

Room 1

Name 2

4

Name 3

Room 3

Name 3

Room 1

Name 3

5

Name 4

Room 4

Name 4

Room 1

Name 4

6

Name 5

Room 5

Name 5

Room 1

Name 5

7

Name 6

Room 6

Name 6

Room 2

Name 6

8

Name 7

Room 7

Name 7

Room 2

Name 7

9

Name 8

Room 8

Name 8

Room 2

Name 8

10

Name 9

Room 9

Name 9

Room 2

Name 9

11

Name 10

Room 10

Name 10

Room 2

Name 10

12

Name 11

Room 11

Name 11

Room 3

Name 11

13

Name 12

Room 12

Name 12

Room 3

Name 12

14

Name 13

Room 13

Name 13

Room 3

Name 13

15

Name 14

Room 14

Name 14

Room 3

Name 14

16

Name 15

Room 15

Name 15

Room 3

Name 15

17

Name 16

Room 16

Name 16

Room 4

Name 16

18

Name 17

Room 17

Name 17

Room 4

Name 17

19

Name 18

Room 18

Name 18

Room 4

Name 18

20

Name 19

Room 19

Name 19

Room 4

Name 19

21

Name 20

Room 20

Name 20

Room 4

Name 20

22

Name 21

Room 21

Name 21

Room 5

Name 21

23

Name 22

Room 22

Name 22

Room 5

Name 22

24

Name 23

Room 23

Name 23

Room 5

Name 23

25

Name 24

Room 24

Name 24

Room 5

Name 24

26

Name 25

Room 25

Name 25

Room 5

Name 25

27

Name 26

Room 26

Name 26

Room 6

Name 26

28

Name 27

Room 27

Name 27

Room 6

Name 27

29

Name 28

Room 28

Name 28

Room 6

Name 28

30

Name 29

Room 29

Name 29

Room 6

Name 29

31

Name 30

Room 30

Name 30

Room 6

Name 30

Allocation

Cell Formulas
Range	Formula
D2:E201	D2	=TEXTSPLIT(fncAssignNameToAGroup(B2:B43,A2:A201,TRUE),",","**",TRUE)
G2:H201	G2	=TEXTSPLIT(fncAssignNameToAGroup(B2:B43,A2:A201,FALSE),",","**",TRUE)
Dynamic array formulas.

VBA Code:

Public Function fncAssignNameToAGroup(rngRooms As Range, rngNames As Range, blnNameFirst As Boolean) As String
Dim lngRooms As Long
Dim lngPeople As Long
Dim arrAlloc() As String
Dim arrNames() As Variant
Dim arrRooms() As Variant
Dim strString  As String
Dim intName As String
Dim i As Integer
Dim ii As Integer

        lngRooms = rngRooms.Rows.Count
        lngPeople = rngNames.Rows.Count

         If (lngPeople Mod lngRooms) = 0 Then
            arrAlloc = Split(Mid(WorksheetFunction.Rept("," & lngPeople / lngRooms, lngRooms), 2), ",")
        Else
            arrAlloc = Split(Mid(WorksheetFunction.Rept("," & WorksheetFunction.RoundUp(lngPeople / lngRooms, 0), (lngPeople Mod lngRooms)) & _
                WorksheetFunction.Rept("," & (WorksheetFunction.RoundUp(lngPeople / lngRooms, 0) - 1), lngRooms - (lngPeople Mod lngRooms)), 2), ",")
        End If
        
        arrNames = rngNames
        arrRooms = rngRooms
                
        intName = 1
                
        For i = LBound(arrAlloc) To UBound(arrAlloc)
            For ii = 1 To arrAlloc(i)
                If blnNameFirst Then
                    strString = strString & arrNames(intName, 1) & "," & arrRooms(i + 1, 1) & "**"
                Else
                    strString = strString & arrRooms(i + 1, 1) & "," & arrNames(intName, 1) & "**"
                End If
                intName = intName + 1
            Next ii
        Next i
                
        fncAssignNameToAGroup = strString
        
End Function

Herakles · Oct 22, 2023

Herakles said:
Another fun option based to some extent upon the work by jolivanes in Post #10 this is called from a cell and acts similar to a SPILL formula.

It will only work if you have the TEXTSPLIT function on your Excel version.

This is the cell formula.
A call to the fncAssignNameToAGroup function wrapped in the Excel TEXTSPLIT function
=TEXTSPLIT(fncAssignNameToAGroup(B2:B43,A2:A201,TRUE),",","**",TRUE)

It depends on two ranges, one containing the room names and one containing the names of the occupants and a boolean indicating
whether you want the Occupant first (TRUE) or Room Name first (FALSE).

Assign Name to a group.xlsm
A B C D E F G H
1 Name Rooms Occupant Room Room Occupant
2 Name 1 Room 1 Name 1 Room 1 Room 1 Name 1
3 Name 2 Room 2 Name 2 Room 1 Room 1 Name 2
4 Name 3 Room 3 Name 3 Room 1 Room 1 Name 3
5 Name 4 Room 4 Name 4 Room 1 Room 1 Name 4
6 Name 5 Room 5 Name 5 Room 1 Room 1 Name 5
7 Name 6 Room 6 Name 6 Room 2 Room 2 Name 6
8 Name 7 Room 7 Name 7 Room 2 Room 2 Name 7
9 Name 8 Room 8 Name 8 Room 2 Room 2 Name 8
10 Name 9 Room 9 Name 9 Room 2 Room 2 Name 9
11 Name 10 Room 10 Name 10 Room 2 Room 2 Name 10
12 Name 11 Room 11 Name 11 Room 3 Room 3 Name 11
13 Name 12 Room 12 Name 12 Room 3 Room 3 Name 12
14 Name 13 Room 13 Name 13 Room 3 Room 3 Name 13
15 Name 14 Room 14 Name 14 Room 3 Room 3 Name 14
16 Name 15 Room 15 Name 15 Room 3 Room 3 Name 15
17 Name 16 Room 16 Name 16 Room 4 Room 4 Name 16
18 Name 17 Room 17 Name 17 Room 4 Room 4 Name 17
19 Name 18 Room 18 Name 18 Room 4 Room 4 Name 18
20 Name 19 Room 19 Name 19 Room 4 Room 4 Name 19
21 Name 20 Room 20 Name 20 Room 4 Room 4 Name 20
22 Name 21 Room 21 Name 21 Room 5 Room 5 Name 21
23 Name 22 Room 22 Name 22 Room 5 Room 5 Name 22
24 Name 23 Room 23 Name 23 Room 5 Room 5 Name 23
25 Name 24 Room 24 Name 24 Room 5 Room 5 Name 24
26 Name 25 Room 25 Name 25 Room 5 Room 5 Name 25
27 Name 26 Room 26 Name 26 Room 6 Room 6 Name 26
28 Name 27 Room 27 Name 27 Room 6 Room 6 Name 27
29 Name 28 Room 28 Name 28 Room 6 Room 6 Name 28
30 Name 29 Room 29 Name 29 Room 6 Room 6 Name 29
31 Name 30 Room 30 Name 30 Room 6 Room 6 Name 30
Allocation
Cell Formulas
Range Formula
D2:E201 D2 =TEXTSPLIT(fncAssignNameToAGroup(B2:B43,A2:A201,TRUE),",","**",TRUE)
G2:H201 G2 =TEXTSPLIT(fncAssignNameToAGroup(B2:B43,A2:A201,FALSE),",","**",TRUE)
Dynamic array formulas.

VBA Code:

Public Function fncAssignNameToAGroup(rngRooms As Range, rngNames As Range, blnNameFirst As Boolean) As String Dim lngRooms As Long Dim lngPeople As Long Dim arrAlloc() As String Dim arrNames() As Variant Dim arrRooms() As Variant Dim strString As String Dim intName As String Dim i As Integer Dim ii As Integer lngRooms = rngRooms.Rows.Count lngPeople = rngNames.Rows.Count If (lngPeople Mod lngRooms) = 0 Then arrAlloc = Split(Mid(WorksheetFunction.Rept("," & lngPeople / lngRooms, lngRooms), 2), ",") Else arrAlloc = Split(Mid(WorksheetFunction.Rept("," & WorksheetFunction.RoundUp(lngPeople / lngRooms, 0), (lngPeople Mod lngRooms)) & _ WorksheetFunction.Rept("," & (WorksheetFunction.RoundUp(lngPeople / lngRooms, 0) - 1), lngRooms - (lngPeople Mod lngRooms)), 2), ",") End If arrNames = rngNames arrRooms = rngRooms intName = 1 For i = LBound(arrAlloc) To UBound(arrAlloc) For ii = 1 To arrAlloc(i) If blnNameFirst Then strString = strString & arrNames(intName, 1) & "," & arrRooms(i + 1, 1) & "**" Else strString = strString & arrRooms(i + 1, 1) & "," & arrNames(intName, 1) & "**" End If intName = intName + 1 Next ii Next i fncAssignNameToAGroup = strString End Function

Or if you don't have the TEXTSPLIT function.

VBA Code:

Public Function fncAssignNameToAGroup(rngRooms As Range, rngNames As Range, blnNameFirst As Boolean) As Variant
Dim lngRooms As Long
Dim lngPeople As Long
Dim arrAlloc() As String
Dim arrNames() As Variant
Dim arrRooms() As Variant
Dim arrResult() As Variant
Dim intName As String
Dim i As Integer
Dim ii As Integer

        ReDim arrResult(1 To rngNames.Rows.Count, 1 To 2)
        
        lngRooms = rngRooms.Rows.Count
        lngPeople = rngNames.Rows.Count

         If (lngPeople Mod lngRooms) = 0 Then
            arrAlloc = Split(Mid(WorksheetFunction.Rept("," & lngPeople / lngRooms, lngRooms), 2), ",")
        Else
            arrAlloc = Split(Mid(WorksheetFunction.Rept("," & WorksheetFunction.RoundUp(lngPeople / lngRooms, 0), (lngPeople Mod lngRooms)) & _
                WorksheetFunction.Rept("," & (WorksheetFunction.RoundUp(lngPeople / lngRooms, 0) - 1), lngRooms - (lngPeople Mod lngRooms)), 2), ",")
        End If
        
        arrNames = rngNames
        arrRooms = rngRooms
                
        intName = 1
                        
        For i = LBound(arrAlloc) To UBound(arrAlloc)
            For ii = 1 To arrAlloc(i)
                If blnNameFirst Then
                    arrResult(intName, 1) = arrNames(intName, 1)
                    arrResult(intName, 2) = arrRooms(i + 1, 1)
                Else
                    arrResult(intName, 1) = arrRooms(i + 1, 1)
                    arrResult(intName, 2) = arrNames(intName, 1)
                End If
                intName = intName + 1
            Next ii
        Next i
                
        fncAssignNameToAGroupArray = arrResult
        
End Function

Assign Name to a group (VBA)

rpaulson

Well-known Member

rpaulson

Well-known Member

Excel Facts

Herakles

Well-known Member

Herakles

Well-known Member

Similar threads

Forum statistics

Share this page

Assign Name to a group (VBA)

rpaulson

Well-known Member

rpaulson

Well-known Member

Excel Facts

Herakles

Well-known Member

Herakles

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock