How to group Name List with VBA in Excel

How to group Name List with VBA in Excel

Please follow the each step as below:
1-First you create Name list in one column  and  determine the cell to type the number for grouping
   that go with the following picture:

2- then create a module  VBA code by press Alt+F11  as following code:

Sub MakeGroups()
'
' This macro is to take a classlist at column A on
' a spreadsheet and divide those members into groups
' with a size defined at B2.
' Group size must be a positive number greater than 1.
' If a group does not divide evenly then:
'    If only one extra member then assign to last group
'    If two or more extra members then form a new group
'
'
'
    Dim class As Range
    Dim Members As Range
    'get the size of the groups and test for > 1
    groupSize = Int(Range("number_per_group"))
    If groupSize < 2 Then
        MsgBox "Please type the number of persons per group at least greater than 1!"
        Range("number_per_group").Select
        Exit Sub
    End If
    ' Find the class members
    Set class = Range("A2", Range("A2").End(xlDown))

    ' Find the number in the class
    n = class.Rows.Count
 
    ' Temporarily create a column of names and an
    ' associated column of random numbers
    Set Members = Range("O2", Range("P2").Offset(n - 1, 0))
    For i = 1 To class.Rows.Count
        Members(i, 1) = class(i)
        Members(i, 2) = Rnd()
    Next i
    ' Sort by the random numbers to put the list in random order
    Members.Sort Members.Columns(2)
   
    ' Take each member in order from the random list and
    ' fill the groups
    ActiveSheet.Columns(5).Clear
           Range("E1").Select
     
     With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    If (n / Range("number_per_group") - Int(n / Range("number_per_group"))) * Range("number_per_group") <= 1 Then
    ActiveCell = "#Groups=" & " " & Int(n / Range("number_per_group"))
    ActiveCell.Font.Bold = True
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Font.Bold = True
   Else
   ActiveCell = "#Groups in Khmer=" & " " & Int(n / Range("number_per_group")) + 1
    ActiveCell.Font.Bold = True
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Font.Bold = True
  End If
    
    randomMember = 1
    For groupNumber = 1 To n \ Range("number_per_group")
        ActiveCell = "Group " & groupNumber
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent4
            .TintAndShade = 0.399975585192419
            .PatternTintAndShade = 0
         End With
    ActiveCell.Font.Bold = True
        ' fill one group
        For groupMember = 1 To groupSize
            ActiveCell.Offset(groupMember, 0) = Members(randomMember, 1)
            randomMember = randomMember + 1
        Next groupMember
        ' skip a space after each group
        ActiveCell.Offset(groupMember + 1, 0).Select
    Next groupNumber
    ' the even groups are filled
   
    ' Now check for extras
    leftovers = n - (randomMember - 1)
   
    If leftovers > 1 Then
        ' make a new group if more than one extra
        ActiveCell = "Group " & groupNumber
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
        ActiveCell.Font.Bold = True
        ActiveCell.Offset(1, 0).Select
    Else
        ' add the extra to the last group if only one
        ActiveCell.Offset(-1, 0).Select
    End If
           
    For i = 1 To leftovers
            ActiveCell = Members(randomMember, 1)
            ActiveCell.Offset(1, 0).Select
            randomMember = randomMember + 1
    Next i
   
    ' Get rid of the temporary data
    ActiveSheet.Columns(15).Clear
    ActiveSheet.Columns(16).Clear
   
    Range("d1").Select
End Sub

Posted in: Computer Skill