Extraction common data from range

[jlister]

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.

 

[BrianB]

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
'
'======================================
'- MAIN MACRO
'======================================
Sub test()
    Set Diners = Worksheets("Diners")
    LastRow = Diners.Range("B65536").End(xlUp).Row
    DinerCheckCol = "F"
    Diners.Columns(DinerCheckCol).ClearContents
    AllAllocated = False
    '-------------------------------------------------------
    Set Tables = Worksheets("Tables")
    Set TableRange = Tables.Range("A1:T12")
    Set TableTotals = Tables.Range("A13:T13")
    TableRange.ClearContents
    TableTotals.ClearContents
    '-------------------------------------------------------
    For CurrentTable = 1 To 20
        For Checkrow = 1 To LastRow
            DinersToSeats
            '- check if all diners have been allocated seats
            If DinersetsOK = LastRow Then
                MsgBox ("Done")
                Exit Sub
            End If
        Next
    Next
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
            Next
            Diners.Cells(Checkrow, DinerCheckCol).Value = "OK"
            DinersetsOK = DinersetsOK + 1
        End If
    End If
End Sub
'===========================================================

 

[jlister]

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?

Regards

 

[BrianB]

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.

 

[jlister]

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.

Regards