Extraction common data from range


Board Regular
Nov 16, 2004
As a relatively new user, I am looking for some assistance with a little project I have and undertake and do not know whether there is a solution in Excel or whether a macro needs to be written.

I am organising a function where on the RSVP, guests can opt to sit with other people they know will be attending.

As a database, I have set up a spreadsheet with Column "A" being the guests and Columns "B" through to "E" being who they would like to sit with. These names have been put in randomly and all of those listed in range B1:E240 are also listed in ColumnClmn A.

Each table seats 12 people and what I want to do is get Excel to allocate who sits at what table. Tables will be numbered 1 - 20.

Any assistance will be greatly appreciated.

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
This works from the list of guests down column B with columns C to E containing those they want to sit with. Each group of people in the row then determines a "set" which can be 1 to 4 people. Columns should be filled left to right.

The macro goes down the list filling each table in turn. It skips sets that are too big to fit in the remaining places until it finds space on a later table.

It uses 2 sheets called "Diners" and "Tables". The tables sheet is cleared each time, so the macro can be run if more diners appear later.

'- diners
Dim Diners As Worksheet
Dim DinersetRange As Range  ' sit together
Dim DinerSet As Integer     ' number in set
Dim DinerCheckCol As String ' check set has been allocated
Dim DinersetsOK As Integer  ' count allocated sets
Dim LastRow As Long
Dim Checkrow As Long
'- tables
Dim Tables As Worksheet
Dim TableRange As Range     ' all tables
Dim TableTotals As Range    ' seats allocated
Dim CurrentTable As Integer
Dim SeatsLeft As Integer
Sub test()
    Set Diners = Worksheets("Diners")
    LastRow = Diners.Range("B65536").End(xlUp).Row
    DinerCheckCol = "F"
    AllAllocated = False
    Set Tables = Worksheets("Tables")
    Set TableRange = Tables.Range("A1:T12")
    Set TableTotals = Tables.Range("A13:T13")
    For CurrentTable = 1 To 20
        For Checkrow = 1 To LastRow
            '- check if all diners have been allocated seats
            If DinersetsOK = LastRow Then
                MsgBox ("Done")
                Exit Sub
            End If
End Sub
'- allocate diners to seats
Sub DinersToSeats()
    If IsEmpty(Diners.Cells(Checkrow, DinerCheckCol)) Then
        Set DinersetRange = Diners.Range("B" & Checkrow & ":E" & Checkrow)
        DinerSet = Application.WorksheetFunction.CountA(DinersetRange)
        SeatsLeft = 12 - TableTotals(CurrentTable)
        '- check enough seats left
        If SeatsLeft >= DinerSet Then
            '- allocate diner set to seats
            For d = 1 To DinerSet
                TableRange.Cells(12 - SeatsLeft + d, CurrentTable).Value = DinersetRange(d).Value
                TableTotals(CurrentTable).Value = TableTotals(CurrentTable).Value + 1
            Diners.Cells(Checkrow, DinerCheckCol).Value = "OK"
            DinersetsOK = DinersetsOK + 1
        End If
    End If
End Sub
Upvote 0
Thanks Brian

Not too sure how it should work.

I have created two new worksheets, "Diners" and "Tables" and then under the main database "Guests" I copied what you have supplied to a new MACRO and when I run the macro, all I get is an "OK" in column F of the "Diners" workbook and nothing else.

I must be doing something wrong - what could it be?

Upvote 0
My test data in the Diners sheet is laid out like this :
Starting in Row 1, each row of data (columns B to E) consists of people who want to sit together.
Some rows may have only 1 name, others 2,3 or 4.
Names are filled in left to right. No blank cells between names.
Column B has no empty cells.
(if necessary this can be achieved by selecting the row and doing a Data/Sort left to right. Select another row and press F4 key to repeat.)

Running the macro puts the names into columns in the Tables sheet, a column for each table and a total for each table in row 13.
Upvote 0
Thanks Brian

It is now doing what I need it to do.

Your assistance has been greatly appreciated.

I don't know what people like me would do without this site and people like you.

Upvote 0

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back