'Creates random groups of books with specified group size and specified number of books per title.
'Tries to use up all books.
'This sub needs (calls) UDF sbRandHistogrm.
'(C) (P) Bernd Plumhoff, v0.3 19-Oct-2020
'Source: https://berndplumhoff.gitbook.io/sulprobil/excel/excel-vba-solutions/sbrandhistogrm
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
'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(1, bicTitle).End(xlDown))
lSize = Range("GroupSize")
'Second part - Create groups
lTotal = .Sum(.Index(.Transpose(vI), bicCount))
ReDim lOut(1 To lSize, 1 To lTotal \ lSize) As Long
ReDim lStats(1 To lBooks, 0 To statsUBound - 1) As Long
Do While CountNonZero(vI) >= lSize 'As long as we can fill a group we continue
dMax = .Max(.Index(.Transpose(vI), bicCount))
vT = .Index(.Transpose(vI), bicCount)
For i = LBound(vT) To UBound(vT)
'Exponentially scaled weights are better than linear ones
If vT(i) > 0# Then vT(i) = Exp(vT(i) / dMax * 5#) 'Change 5# if necessary
'See https://berndplumhoff.gitbook.io/sulprobil/excel/excel-vba-solutions/sbrandhistogrm
j = Int(sbRandHistogrm(1#, CDbl(lBooks) + 1#, vT))
vT(j) = 0 'This book must not reappear in this group
vI(j, bicCount) = vI(j, bicCount) - 1
lStats(j, statsCheck) = lStats(j, statsCheck) + 1
lStats(j, statsAvgGroup) = lStats(j, statsAvgGroup) + lGroups
If lStats(j, statsMinGroup) = 0 Then lStats(j, statsMinGroup) = lGroups
lStats(j, statsMaxGroup) = lGroups
Call MsgBox("No group. Number of books is too small or size of groups too large.", vbOKOnly, "Error")
ReDim Preserve lOut(1 To lSize, 1 To lGroups) As Long
'Third part - Fill output sheet
Range(wsO.Cells(1, 1), wsO.Cells(lGroups, lSize)).FormulaArray = .Transpose(lOut)
'Fourth part - some statistics to reassure the user that we got a good mix and used up as many books as possible
lStats(i, statsRest) = vI(i, bicCount)
lStats(i, statsAvgGroup) = lStats(i, statsAvgGroup) \ lStats(i, statsCheck)
Range("GroupsGenerated") = lGroups
Range(wsI.Cells(2, bicStats + statsCheck), wsI.Cells(1 + lBooks, bicStats + statsUBound - 1)).FormulaArray = lStats
Set state = Nothing 'Not even necessary - will be done automatically
Function CountNonZero(v As Variant) As Long
For i = LBound(v, 1) To UBound(v, 1)
If v(i, bicCount) <> 0 Then n = n + 1