Create Random Unique Groups of 5, Keep Duplicates in Column

erinmc42

New Member
Joined
Oct 12, 2020
Messages
1
Office Version
  1. 365
Platform
  1. Windows
I have a spreadsheet of thousands of books that need to be broken down into groups of 5 titles. I want to know how many unique groups can be created from this list. The catch is, some titles have 600 copies, while some have only 1.

How can Excel create my groups of books?

Also, do I have any other choice but to begin with a column with 635 of ON THE FARM in every row of the column, followed by 443 of MARS, etc?
Screenshot 2020-10-12 142710.png


Thank you for any assistance.
 

Some videos you may like

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

Sulprobil

Board Regular
Joined
May 12, 2020
Messages
114
Office Version
  1. 2016
Platform
  1. Windows
You can randomly create groups of 5 until you have less than 4 different books left.
The random selection can use your book count as weight, you can "draw" On the farm with weight 635 and you will "draw" I can run only with weight 192, for example.
I created a simple simulation:
MrExcel_Create Random Unique Groups of 5 Keep Duplicates in Column.xlsm
ABCDEFGH
1NumberCountTitleI want groups of5CheckRest
21635On the farm57659
32443Mars4412
43329Let's explore the stars3290
54300Cat got a lot3000
65266Being Present2660
76253Garden Day!2530
87252Jonathan cleaned up … then he heard a sound2520
98226Aaron is a good sport2260
109224Rocket the brave!2240
1110222Story of Ferdinand2220
1211220Soccer Time!2200
1312209Becoming a Salamander2090
1413192I can run1920
Input
Cell Formulas
RangeFormula
G2:G14G2=COUNTIF(Output!$1:$1048576,Input!A2)
H2:H14H2=B2-G2

VBA Code:
Option Explicit

Enum book_info_columns
    bicNumber = 1
    bicCount
    bicTitle
End Enum

Sub CreateGroups()
Dim i As Long, j As Long, lBooks As Long, lGroups As Long, lSize As Long, lTotal As Long
Dim vI As Variant, vT As Variant
Dim state As SystemState    'See https://berndplumhoff.gitbook.io/sulprobil/excel/excel-vba-solutions/classes/systemstate

With Application.WorksheetFunction
Set state = New SystemState 'Speed up VBA

'First part - Read in book information and group size
vI = Range(wsI.Cells(2, bicNumber), wsI.Cells(2, bicTitle).End(xlDown))
lSize = Range("GroupSize")

'Second part - Create groups
Randomize
lBooks = UBound(vI, 1)
lTotal = .Sum(.Index(.Transpose(vI), bicCount))
ReDim vO(1 To lSize, 1 To lTotal \ lSize) As Variant
Do While CountNonZero(vI) >= lSize
    lGroups = lGroups + 1
    vT = .Index(.Transpose(vI), bicCount)
    For i = 1 To lSize
        j = Int(sbRandHistogrm(1#, CDbl(lBooks) + 1#, vT)) 'See https://berndplumhoff.gitbook.io/sulprobil/excel/excel-vba-solutions/sbrandhistogrm
        vT(j) = 0
        vO(i, lGroups) = j
        vI(j, bicCount) = vI(j, bicCount) - 1
    Next i
Loop
ReDim Preserve vO(1 To lSize, 1 To lGroups) As Variant

'Third part - Fill output sheet
wsO.Cells.ClearContents
Range(wsO.Cells(1, 1), wsO.Cells(lGroups, lSize)).FormulaArray = .Transpose(vO)
wsI.Calculate
Set state = Nothing 'Not even necessary - will be done automatically
End With
End Sub

Function CountNonZero(v As Variant) As Long
Dim i As Long, n As Long
For i = LBound(v, 1) To UBound(v, 1)
    If v(i, bicCount) <> 0 Then n = n + 1
Next i
CountNonZero = n
End Function

You can also download this file here (download, open, and use at your own risk - but I am using an up-to-date virus scanning program):

There are better ways to use up almost all books but this approach was fairly easy - and it's "random".
 

Watch MrExcel Video

Forum statistics

Threads
1,113,890
Messages
5,544,887
Members
410,643
Latest member
sng
Top