Formula to Evenly Distribute Guests on a Seating Plan

[markmogli]

Hello,

I have a spreadsheet where column A has the company name and column B has the total guests booked to attend the event. I need to allocate the guests to tables where the smallest can be a table of 7 and the largest can be a table of 14. I also need to allocate the party to the smallest number of tables possible.

A party of 15 guests will be seated as 1 x table of 7 and 1 x table 8.


A party of 20 guests will be seated as 2 x tables of 10.


A party of 36 guests can be seated as either

3 x tables of 12

or

1 x table of 13, 1 x table of 12 and 1 x table of 11


A party of 100 guests can be seated as:

10 tables of 10

but they could also be seated as:

6 x tables of 14 and 2 x tables of 8


I have 2,200 guests to seat and a maximum of 220 tables. I want the least possible tables and as bonus points, I only have 30 tables which will take 13 or 14 guests, the other 190 tables seat a max of 12.

 

[lrobbo314]

One last update because this one was fun. Below is an updated VBA solution that gets rid of the matrix and does everything in memory. And the other is a Power Query solution.

Book1
	A	B	C
1	Customer	Guests	Result
2	Company 1	119	1x7, 8x14
3	Company 2	9	1x9
4	Company 3	60	2x9, 3x14
5	Company 4	60	2x9, 3x14
6	Company 5	15	1x7, 1x8
7	Company 6	16	2x8
8	Company 7	12	1x12
9	Company 8	19	1x9, 1x10
10	Company 9	29	1x7, 1x8, 1x14
11	Company 10	19	1x9, 1x10
12	Company 11	9	1x9
13	Company 12	10	1x10
14	Company 13	11	1x11
15	Company 14	26	1x12, 1x14
16	Company 15	14	1x14
Sheet7

Sub ALLOCATE()
Dim AL As Object:           Set AL = CreateObject("System.Collections.ArrayList")
Dim r As Range:             Set r = Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row)
Dim AR() As Variant:        AR = r.Value
Dim Res() As Variant:       ReDim Res(1 To UBound(AR))
Dim MinTblSize As Integer:  MinTblSize = 6
Dim MaxTblSize As Integer:  MaxTblSize = 14
Dim Total As Long, Dif As Long, MaxLarge As Long, sp As Long

For i = 1 To UBound(AR)
    Total = AR(i, 2)
    If Total < MaxTblSize Then
        AL.Add fStr(1, AR(i, 2))
    Else
        MaxLarge = Int(AR(i, 2) / MaxTblSize)
        Dif = AR(i, 2) - (MaxLarge * MaxTblSize)
        If Dif > 0 Then
            If Dif >= MinTblSize And Dif < MaxTblSize Then
                AL.Add fStr(1, Dif)
            Else
                Dif = Dif + MaxTblSize
                MaxLarge = MaxLarge - 1
                If Dif Mod 2 = 1 Then
                    sp = Int(Dif / 2)
                    AL.Add fStr(1, sp)
                    AL.Add fStr(1, sp + 1)
                Else
                    AL.Add fStr(2, Dif / 2)
                End If
            End If
            If MaxLarge > 0 Then AL.Add fStr(MaxLarge, 14)
        Else
            AL.Add fStr(MaxLarge, MaxTblSize)
        End If
    End If
    Res(i) = Join(AL.toarray, ", ")
    AL.Clear
Next i

r.Resize(r.Rows.Count, 1).Offset(, 2).Value = Application.Transpose(Res)
            
End Sub

Function fStr(num As Variant, size As Variant) As String
fStr = num & "x" & size
End Function

PQ

Book1
	D	E	F
1	Customer	Guests	Final
2	Company 1	119	1x7, 8x14
3	Company 2	9	1x9
4	Company 3	60	2x9, 3x14
5	Company 4	60	2x9, 3x14
6	Company 5	15	1x7, 1x8
7	Company 6	16	2x8
8	Company 7	12	1x12
9	Company 8	19	1x9, 1x10
10	Company 9	29	1x7, 1x8, 1x14
11	Company 10	19	1x9, 1x10
12	Company 11	9	1x9
13	Company 12	10	1x10
14	Company 13	11	1x11
15	Company 14	26	1x12, 1x14
16	Company 15	14	1x14
Sheet8

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Customer", type text}, {"Guests", Int64.Type}}),
    Max14 = Table.AddColumn(#"Changed Type", "Max14", each Number.RoundDown([Guests]/14)),
    Total14 = Table.AddColumn(Max14, "Total14", each [Max14]*14),
    Diff = Table.AddColumn(Total14, "Diff", each if [Total14] = [Guests] then null else [Guests]-[Total14]),
    NewDiff = Table.AddColumn(Diff, "NewDiff", each if [Diff] = null then null else
if [Diff] < 6 then [Diff]+14 else [Diff]),
    New14 = Table.AddColumn(NewDiff, "New14", each if [NewDiff] = null then [Guests] else
if [Diff]=[NewDiff] then [Max14] else [Max14]-1),
    Div = Table.AddColumn(New14, "Div", each if [NewDiff] = null then null else
if [NewDiff] <=14 then [NewDiff] else [NewDiff] /2),
    Num1 = Table.AddColumn(Div, "Num1", each if Int64.From([Div])-[Div] = 0 then [Div] else Number.RoundDown([Div])),
    Num2 = Table.AddColumn(Num1, "Num2", each if [Div] = [Num1] then null else [Num1]+1),
    #"14" = Table.AddColumn(Num2, "14Count", each if [New14] = 0 then null else
if [New14] = [Total14] then "1x" & Text.From([Total14]) else if [New14] > 0 then Text.From([New14]) & "x" & "14" else null),
    R1 = Table.AddColumn(#"14", "R1", each if [Num1] = null then null else
if [NewDiff] > [Diff] and [Num2] = null then  "2x" & Text.From([Num1]) else
"1x" & Text.From([Num1])),
    R2 = Table.AddColumn(R1, "R2", each if [Diff] = null then null else "1x" & Text.From([Num2])),
    Replace = Table.ReplaceValue(R2,null,"",Replacer.ReplaceValue,{"14Count", "R1", "R2"}),
    Final = Table.AddColumn(Replace, "Final", each Text.Combine(Table.ToList(Table.SelectRows(Table.Transpose(Table.FromColumns({{[R1]},{[R2]},{[14Count]}})), each Text.Length([Column1])>0)),", ")),
    Remove = Table.RemoveColumns(Final,{"Max14", "Total14", "Diff", "NewDiff", "New14", "Div", "Num1", "Num2", "14Count", "R1", "R2"})
in
    Remove

 

[markmogli]

Wow, thanks for that, Irobbo314.

Is there anyway to do this without VBA / PQ, using jut formulas?