Create Random Unique Groups of 5, Keep Duplicates in Column

[erinmc42]

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?

Thank you for any assistance.

 

[Sulprobil]

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
	A	B	C	D	E	F	G	H
1	Number	Count	Title	I want groups of	5		Check	Rest
2	1	635	On the farm				576	59
3	2	443	Mars				441	2
4	3	329	Let's explore the stars				329	0
5	4	300	Cat got a lot				300	0
6	5	266	Being Present				266	0
7	6	253	Garden Day!				253	0
8	7	252	Jonathan cleaned up … then he heard a sound				252	0
9	8	226	Aaron is a good sport				226	0
10	9	224	Rocket the brave!				224	0
11	10	222	Story of Ferdinand				222	0
12	11	220	Soccer Time!				220	0
13	12	209	Becoming a Salamander				209	0
14	13	192	I can run				192	0
Input

Cell Formulas
Range	Formula
G2:G14	G2	=COUNTIF(Output!$1:$1048576,Input!A2)
H2:H14	H2	=B2-G2

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):

Dropbox - File Deleted - Simplify your life

www.dropbox.com

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