The function attempts to divide a given number of discrete items into equal groups and minimize the number of groups needed. This is useful for scenarios where you may want to avoid layouts where you have 4 items on first page and only 1 items on second page. Running 5 items for maximum of 4 through the function will return { 3, 2 }, enabling you to know that you’d put 3 items on one page and 2 on next page.

Here’s some examples of output the function will return for different parameters.

For a maximum of 5 items per group:

Items #: 1 2 3 4 5 6 7 8 9 10 11 12
Group 1: 1 2 3 4 5 3 4 4 5 5 4 4
Group 2: 0 0 0 0 0 3 3 4 4 5 4 4
Group 3: 0 0 0 0 0 0 0 0 0 0 3 4

For a maximum of 4 items per group:

Items #: 1 2 3 4 5 6 7 8 9 10 11 12
Group 1: 1 2 3 4 3 3 4 4 3 4 4 4
Group 2: 0 0 0 0 2 3 3 4 3 3 4 4
Group 3: 0 0 0 0 0 0 0 0 3 3 3 4

Likewise, 3 maximum per group:

Items #: 1 2 3 4 5 6 7 8 9 10 11 12
Group 1: 1 2 3 2 3 3 3 3 3 3 3 3
Group 2: 0 0 0 2 2 3 2 3 3 3 3 3
Group 3: 0 0 0 0 0 0 2 2 3 2 3 3
Group 4: 0 0 0 0 0 0 0 0 0 2 2 3

The function expects two input and will infer the minimum number of groups required to distribute the discrete items equally as possible and returns the result as an array in the same order as you would have seen in the example shown above. You can infer the number of groups needed by doing a Ubound() + 1 on the returned array.

' EqualGrouping
' http://www.utteraccess.com/wiki/EqualGrouping
' Code courtesy of UtterAccess Wiki
' Licensed under Creative Commons License
' http://creativecommons.org/licenses/by-sa/3.0/
'
' You are free to use this code in any application,
' provided this notice is left unchanged.
'
' rev  date                          brief descripton
' 1.0  2011-10-20                    
'
Public Function EqualGrouping( _
  MaxPerGroup As Long, _
  ItemCount As Long _
) As Long()

Dim lngGroupsNeeded As Long
Dim lngItems As Long
Dim lngResult As Long
Dim lngResults() As Long
Dim i As Long 'Iterator

If ItemCount < MaxPerGroup Then
  ReDim lngResults(0)
  lngResults(0) = ItemCount
Else
  If ItemCount Mod MaxPerGroup Then
      lngGroupsNeeded = (ItemCount \ MaxPerGroup) + 1
  Else
      lngGroupsNeeded = ItemCount / MaxPerGroup
  End If
  lngItems = ItemCount
 
  ReDim lngResults(lngGroupsNeeded - 1)
  For i = lngGroupsNeeded To 1 Step -1
      lngResult = lngItems \ i
      lngItems = lngItems - lngResult
      lngResults(i - 1) = lngResult
  Next
End If

EqualGrouping = lngResults

End Function