VBA Randomly Distribute A,B,C,D,E Evenly

Stephen_IV

Well-known Member
Joined
Mar 17, 2003
Messages
1,180
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
I have a data set that I would like to have A,B,C,D,E distributed evenly. Below is a sample, I would like to use this on a larger data set. If anyone has a Function or VBA I would appreciate it. Thanks in advance!

STUDENT 1 B
STUDENT 2 C
STUDENT 3 D
STUDENT 4 E
STUDENT 5 B
STUDENT 6 A
STUDENT 7 D
STUDENT 8 A
STUDENT 9 C
STUDENT 10 A
STUDENT 11 B
STUDENT 12 E
STUDENT 13 D
STUDENT 14 C
STUDENT 15 C
STUDENT 16 A
STUDENT 17 E
STUDENT 18 B
STUDENT 19 E
STUDENT 20 D
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
[Table="width:, class:grid"][tr][td="bgcolor:#C0C0C0"][/td][td="bgcolor:#C0C0C0"]
A​
[/td][td="bgcolor:#C0C0C0"]
B​
[/td][td="bgcolor:#C0C0C0"]
C​
[/td][td="bgcolor:#C0C0C0"]
D​
[/td][td="bgcolor:#C0C0C0"]
E​
[/td][td="bgcolor:#C0C0C0"]
F​
[/td][/tr][tr][td="bgcolor:#C0C0C0"]
1​
[/td][td="bgcolor:#F3F3F3"]
Group
[/td][td="bgcolor:#F3F3F3"]
Qty
[/td][td="bgcolor:#F3F3F3"]
CDF
[/td][td="bgcolor:#F3F3F3"]
Check
[/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
2​
[/td][td]
A​
[/td][td]
5​
[/td][td="bgcolor:#E5E5E5"]
0​
[/td][td="bgcolor:#E5E5E5"]
5​
[/td][td][/td][td]C2: =SUM(B$1:B1)[/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
3​
[/td][td]
B​
[/td][td]
5​
[/td][td="bgcolor:#E5E5E5"]
5​
[/td][td="bgcolor:#E5E5E5"]
5​
[/td][td][/td][td]D2: =COUNTIF($B$10:$B$29, A2)[/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
4​
[/td][td]
C​
[/td][td]
5​
[/td][td="bgcolor:#E5E5E5"]
10​
[/td][td="bgcolor:#E5E5E5"]
5​
[/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
5​
[/td][td]
D​
[/td][td]
5​
[/td][td="bgcolor:#E5E5E5"]
15​
[/td][td="bgcolor:#E5E5E5"]
5​
[/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
6​
[/td][td][/td][td="bgcolor:#E5E5E5"]
20​
[/td][td][/td][td][/td][td][/td][td]B6: =SUM(B2:B5)[/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
7​
[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
8​
[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
9​
[/td][td="bgcolor:#F3F3F3"]
Student
[/td][td="bgcolor:#F3F3F3"]
Group
[/td][td="bgcolor:#F3F3F3"]
[/td][td="bgcolor:#F3F3F3"]
[/td][td="bgcolor:#F3F3F3"]
[/td][td="bgcolor:#F3F3F3"]
[/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
10​
[/td][td]
1​
[/td][td="bgcolor:#CCFFCC"]
B​
[/td][td][/td][td][/td][td][/td][td="bgcolor:#CCFFCC"]B10: {=INDEX(A$2:A$5, MATCH(RANDBETWEEN(0, B$6 - ROWS(B$9:B9)), $C$2:$C$5 - COUNTIF(B9:B$9, "<" & A$2:A$5)))}[/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
11​
[/td][td]
2​
[/td][td="bgcolor:#CCFFCC"]
C​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
12​
[/td][td]
3​
[/td][td="bgcolor:#CCFFCC"]
D​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
13​
[/td][td]
4​
[/td][td="bgcolor:#CCFFCC"]
A​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
14​
[/td][td]
5​
[/td][td="bgcolor:#CCFFCC"]
B​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
15​
[/td][td]
6​
[/td][td="bgcolor:#CCFFCC"]
D​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
16​
[/td][td]
7​
[/td][td="bgcolor:#CCFFCC"]
A​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
17​
[/td][td]
8​
[/td][td="bgcolor:#CCFFCC"]
A​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
18​
[/td][td]
9​
[/td][td="bgcolor:#CCFFCC"]
C​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
19​
[/td][td]
10​
[/td][td="bgcolor:#CCFFCC"]
B​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
20​
[/td][td]
11​
[/td][td="bgcolor:#CCFFCC"]
A​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
21​
[/td][td]
12​
[/td][td="bgcolor:#CCFFCC"]
D​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
22​
[/td][td]
13​
[/td][td="bgcolor:#CCFFCC"]
D​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
23​
[/td][td]
14​
[/td][td="bgcolor:#CCFFCC"]
A​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
24​
[/td][td]
15​
[/td][td="bgcolor:#CCFFCC"]
B​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
25​
[/td][td]
16​
[/td][td="bgcolor:#CCFFCC"]
C​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
26​
[/td][td]
17​
[/td][td="bgcolor:#CCFFCC"]
D​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
27​
[/td][td]
18​
[/td][td="bgcolor:#CCFFCC"]
C​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
28​
[/td][td]
19​
[/td][td="bgcolor:#CCFFCC"]
B​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
29​
[/td][td]
20​
[/td][td="bgcolor:#CCFFCC"]
C​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[/table]
 
Upvote 0
Assuming your data is located in Column A and starts on Row 1 (change the red highlighted text if that guess is wrong), give this macro a try...
Code:
Sub RandomEvenDistributionOf()
  Dim R As Long, Cnt As Long, RndIdx As Long, HowMany As Long, What As String
  Dim Tmp As Variant, Data As Variant, Arr As Variant
  Data = Range("[B][COLOR="#FF0000"]A1[/COLOR][/B]", Cells(Rows.Count, "[B][COLOR="#FF0000"]A[/COLOR][/B]").End(xlUp))
  What = "ABCDE"
  HowMany = UBound(Data)
  Arr = Split(Trim(Replace(StrConv(Application.Rept(What, 1 + Int(HowMany / Len(What))), vbUnicode), Chr(0), " ")))
  Randomize
  For Cnt = UBound(Arr) To LBound(Arr) Step -1
    RndIdx = Int((Cnt - LBound(Arr) + 1) * Rnd + LBound(Arr))
    Tmp = Arr(RndIdx)
    Arr(RndIdx) = Arr(Cnt)
    Arr(Cnt) = Tmp
  Next
  Range("[B][COLOR="#FF0000"]A1[/COLOR][/B]").Offset(,1).Resize(HowMany) = Application.Transpose(Arr)
End Sub
Note: If the number of names is not an even multiple of the number of letters you want to distribute, the "odd excess" will be filled randomly from among the letters being distributed.
 
Upvote 0
another VBA option
- if there are 20 students all grades occur 4 times
- if there are 21 students 4 grades occur 4 times, 1 grade occurs 5 times
- if there are 20 students 3 grades occur 4 times, 2 grades occur 5 times
- if there are 20 students 2 grades occur 4 times, 3 grades occur 5 times
- if there are 20 students 1 grade occurs 4 times, 4 grades occur 5 times
- if there are 25 students all grades occur 5 times etc

Code:
Sub Distribute()
    Dim Ws As Worksheet, Rng As Range, Cel As Range, M As Integer, C As Long, a As Long, xMax As Long
    Set Ws = ActiveSheet
    Set Rng = Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp)).Offset(, 1)
    Rng.ClearContents
    C = Rng.Cells.CountLarge            [I][COLOR=#006400]'number of students[/COLOR][/I]
    M = C Mod 5                         [COLOR=#006400][I]'remainder when C is divided by 5[/I][/COLOR]
    xMax = (C - M) / 5                 [I][COLOR=#006400] 'max occurrence for even distribution[/COLOR][/I]
[I][COLOR=#006400]'allocate excluding remainder[/COLOR][/I]
    For a = 1 To C - M
        Set Cel = Rng(a, 1)
        Cel = Chr(WorksheetFunction.RoundUp(Rnd * 5, 0) + 64)
        If WorksheetFunction.CountIf(Rng, Cel) > xMax Then a = a - 1
    Next a
[I][COLOR=#006400]'allocate the remainder[/COLOR][/I]
    For a = C - M + 1 To C
        Set Cel = Rng(a, 1)
        Cel = GetGrade
        If WorksheetFunction.CountIf(Rng, Cel) > xMax + 1 Then a = a - 1
    Next a
End Sub

Student names are in column A starting at A2 (without any blank cells)

Results will differ every time the code is run
- example

Excel 2016 (Windows) 32 bit
[Table="width:, class:head"][tr=bgcolor:#E0E0F0][th] [/th][th]
A
[/th][th]
B
[/th][th]
C
[/th][th]
D
[/th][th]
E
[/th][th]
F
[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
1
[/td][td]Student[/td][td]RESULT[/td][td][/td][td]Grade[/td][td]COUNT[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
2
[/td][td]STUDENT 1[/td][td]B[/td][td][/td][td]A[/td][td]
4​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
3
[/td][td]STUDENT 2[/td][td]E[/td][td][/td][td]B[/td][td]
5​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
4
[/td][td]STUDENT 3[/td][td]D[/td][td][/td][td]C[/td][td]
5​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
5
[/td][td]STUDENT 4[/td][td]B[/td][td][/td][td]D[/td][td]
4​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
6
[/td][td]STUDENT 5[/td][td]B[/td][td][/td][td]E[/td][td]
5​
[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
7
[/td][td]STUDENT 6[/td][td]E[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
8
[/td][td]STUDENT 7[/td][td]C[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
9
[/td][td]STUDENT 8[/td][td]E[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
10
[/td][td]STUDENT 9[/td][td]C[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
11
[/td][td]STUDENT 10[/td][td]B[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
12
[/td][td]STUDENT 11[/td][td]E[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
13
[/td][td]STUDENT 12[/td][td]A[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
14
[/td][td]STUDENT 13[/td][td]A[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
15
[/td][td]STUDENT 14[/td][td]D[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
16
[/td][td]STUDENT 15[/td][td]D[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
17
[/td][td]STUDENT 16[/td][td]C[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
18
[/td][td]STUDENT 17[/td][td]D[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
19
[/td][td]STUDENT 18[/td][td]C[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
20
[/td][td]STUDENT 19[/td][td]A[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
21
[/td][td]STUDENT 20[/td][td]A[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
22
[/td][td]STUDENT 21[/td][td]C[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
23
[/td][td]STUDENT 22[/td][td]E[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
24
[/td][td]STUDENT 23[/td][td]B[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
25
[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[/table]
[Table="width:, class:grid"][tr][td]Sheet: Sheet1[/td][/tr][/table]
 
Last edited:
Upvote 0
With formulas

<table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:76.04px;" /><col style="width:85.54px;" /><col style="width:79.84px;" /><col style="width:249.98px;" /><col style="width:44.67px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >D</td><td >E</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td style="background-color:#92d050; font-weight:bold; text-align:center; ">STUDENT</td><td style="background-color:#92d050; font-weight:bold; text-align:center; ">FINAL GROUP</td><td style="background-color:#92d050; font-weight:bold; text-align:center; ">RANDOM</td><td style="background-color:#92d050; font-weight:bold; text-align:center; ">GROUP repeat from A to B</td><td style="background-color:#92d050; font-weight:bold; text-align:center; ">CHECK</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td >STUDENT 1</td><td >A</td><td style="text-align:right; ">0.950053729</td><td style="background-color:#ffc000; text-align:center; ">A</td><td style="text-align:right; ">4</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td >STUDENT 2</td><td >B</td><td style="text-align:right; ">0.162449816</td><td style="background-color:#ffc000; text-align:center; ">B</td><td style="text-align:right; ">4</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td >STUDENT 3</td><td >E</td><td style="text-align:right; ">0.493879798</td><td style="background-color:#ffc000; text-align:center; ">C</td><td style="text-align:right; ">4</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td >STUDENT 4</td><td >C</td><td style="text-align:right; ">0.36720584</td><td style="background-color:#ffc000; text-align:center; ">D</td><td style="text-align:right; ">4</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >6</td><td >STUDENT 5</td><td >D</td><td style="text-align:right; ">0.301664141</td><td style="background-color:#ffc000; text-align:center; ">E</td><td style="text-align:right; ">4</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td >STUDENT 6</td><td >D</td><td style="text-align:right; ">0.558129856</td><td style="text-align:center; ">A</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >8</td><td >STUDENT 7</td><td >C</td><td style="text-align:right; ">0.274059549</td><td style="text-align:center; ">B</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >9</td><td >STUDENT 8</td><td >B</td><td style="text-align:right; ">0.415170288</td><td style="text-align:center; ">C</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >10</td><td >STUDENT 9</td><td >E</td><td style="text-align:right; ">0.182926025</td><td style="text-align:center; ">D</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >11</td><td >STUDENT 10</td><td >E</td><td style="text-align:right; ">0.092627143</td><td style="text-align:center; ">E</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >12</td><td >STUDENT 11</td><td >C</td><td style="text-align:right; ">0.161204425</td><td style="text-align:center; ">A</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >13</td><td >STUDENT 12</td><td >A</td><td style="text-align:right; ">0.476992103</td><td style="text-align:center; ">B</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >14</td><td >STUDENT 13</td><td >A</td><td style="text-align:right; ">0.278864691</td><td style="text-align:center; ">C</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >15</td><td >STUDENT 14</td><td >C</td><td style="text-align:right; ">0.57026593</td><td style="text-align:center; ">D</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >16</td><td >STUDENT 15</td><td >B</td><td style="text-align:right; ">0.275809365</td><td style="text-align:center; ">E</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >17</td><td >STUDENT 16</td><td >A</td><td style="text-align:right; ">0.817885174</td><td style="text-align:center; ">A</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >18</td><td >STUDENT 17</td><td >B</td><td style="text-align:right; ">0.690742645</td><td style="text-align:center; ">B</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >19</td><td >STUDENT 18</td><td >D</td><td style="text-align:right; ">0.104926195</td><td style="text-align:center; ">C</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >20</td><td >STUDENT 19</td><td >E</td><td style="text-align:right; ">0.28160362</td><td style="text-align:center; ">D</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >21</td><td >STUDENT 20</td><td >D</td><td style="text-align:right; ">0.273532275</td><td style="text-align:center; ">E</td><td > </td></tr></table><br /><table style="font-family:Arial; font-size:10pt; border-style: groove ;border-color:#00ff00;background-color:#fffcf9; color:#000000; "><tr><td ><b></b></td></tr><tr><td ><table border = "1" cellspacing="0" cellpadding="2" style="font-family:Arial; font-size:9pt;"><tr style="background-color:#cacaca; font-size:10pt;"><td >Cell</td><td >Formula</td></tr><tr><td >B2</td><td >=INDEX($D$2:$D$21,RANK(C2,$C$2:$C$21))</td></tr><tr><td >C2</td><td >=RAND()</td></tr><tr><td >E2</td><td >=COUNTIF($B$2:$B$21,D2)</td></tr></table></td></tr></table>

After obtaining the results, you must copy column C and paste as values ​​so that the results no longer move.
 
Upvote 0
Code:
Sub Distribute()
    Dim Ws As Worksheet, Rng As Range, Cel As Range, M As Integer, C As Long, a As Long, xMax As Long
    Set Ws = ActiveSheet
    Set Rng = Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp)).Offset(, 1)
    Rng.ClearContents
    C = Rng.Cells.CountLarge            [I][COLOR=#006400]'number of students[/COLOR][/I]
    M = C Mod 5                         [COLOR=#006400][I]'remainder when C is divided by 5[/I][/COLOR]
    xMax = (C - M) / 5                 [I][COLOR=#006400] 'max occurrence for even distribution[/COLOR][/I]
[I][COLOR=#006400]'allocate excluding remainder[/COLOR][/I]
    For a = 1 To C - M
        Set Cel = Rng(a, 1)
        Cel = Chr(WorksheetFunction.RoundUp(Rnd * 5, 0) + 64)
        If WorksheetFunction.CountIf(Rng, Cel) > xMax Then a = a - 1
    Next a
[I][COLOR=#006400]'allocate the remainder[/COLOR][/I]
    For a = C - M + 1 To C
        Set Cel = Rng(a, 1)
        Cel = [COLOR=#ff0000][B]GetGrade[/B][/COLOR]
        If WorksheetFunction.CountIf(Rng, Cel) > xMax + 1 Then a = a - 1
    Next a
End Sub
What is GetGrade (see red highlighted text above)? This seems to be the only appearance of it in all of your posted code.

Also, you need to include a Randomize statement in your code or I think it will repeat the same sequence each time the workbook is opened.
 
Last edited:
Upvote 0
Thanks @Rick Rothstein


ooops :oops:
I had a function which I decided to remove - changed one line and forgot to change the other !!
Of couse it still worked for me

Code:
Sub Distribute()
    Dim Ws As Worksheet, Rng As Range, Cel As Range, M As Integer, C As Long, a As Long, xMax As Long
    Set Ws = ActiveSheet
    Set Rng = Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp)).Offset(, 1)
    Rng.ClearContents
    C = Rng.Cells.CountLarge            'number of students
    M = C Mod 5                         'remainder when C is divided by 5
    xMax = (C - M) / 5                  'max occurrence for even distribution
'allocate excluding remainder
    For a = 1 To C - M
        Set Cel = Rng(a, 1)
        [COLOR=#006400]Cel = Chr(WorksheetFunction.RoundUp(Rnd * 5, 0) + 64)[/COLOR]
        If WorksheetFunction.CountIf(Rng, Cel) > xMax Then a = a - 1
    Next a
'allocate the remainder
    For a = C - M + 1 To C
        Set Cel = Rng(a, 1)
        [COLOR=#006400]Cel = Chr(WorksheetFunction.RoundUp(Rnd * 5, 0) + 64)[/COLOR]
        If WorksheetFunction.CountIf(Rng, Cel) > xMax + 1 Then a = a - 1
    Next a
End Sub
 
Last edited:
Upvote 0
Also, you need to include a Randomize statement in your code or I think it will repeat the same sequence each time the workbook is opened
@Rick Rothstein - tested that and you are correct
 
Upvote 0
Wow!!!! Thank you all!! I greatly appreciate it!!!! I appreciate all of the approaches!!!
 
Upvote 0

Forum statistics

Threads
1,224,822
Messages
6,181,165
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top