Query to consolidate records

Is the principle involved that you make full names for each person in a household, then for those with the same last name, place them in FullName1, then FullName2 for a record, then FullName1, then FullName2 for another record, and so on until you reach the end of people with the same last name?

I assume that there will be multiple households in the table, so that also has to be taken into account.

I think this can be done using a combination of queries and VBA code.  I will see what I can come up with.  If you have a table with more data, that would be useful.

HOWEVER -- this may not be the correct approach at all.  What are you trying to do here?  If you are aiming at a table with a concatenated list of full names for a household, that can be done much more easily, and would accommodate any number of household members.

Here is a function that fills a table with a concatenated list of children per parent (it is from my Access Archon #89):

Function CreateFlattenedTable()
'Created by Helen Feddema 8-6-2001
'Last modified 10-12-2001

On Error GoTo ErrorHandler

   Dim dbs As DAO.Database
   Dim rstSource As DAO.Recordset
   Dim rstTarget As DAO.Recordset
   Dim strQuery As String
   Dim strTable As String
   Dim strParentName As String
   Dim lngPrevParent As Long
   Dim lngThisParent As Long
   Dim strThisChild As String
   Dim strChildren As String
   Dim strSQL As String
   
   strQuery = "qryParentsAndChildren"
   strTable = "tblParentsAndChildren"
   
   'Clear old target table
   strSQL = "DELETE * FROM " & strTable
   DoCmd.SetWarnings False
   DoCmd.RunSQL strSQL
   
   Set dbs = CurrentDb
   Set rstSource = dbs.OpenRecordset(strQuery, dbOpenDynaset)
   Set rstTarget = dbs.OpenRecordset(strTable, dbOpenDynaset)
   lngPrevParent = 0
   With rstSource
      'Special processing for first record
      lngThisParent = ![ParentID]
      strParentName = ![ParentName]
      strThisChild = ![FirstName]
      Debug.Print "Current parent: " & strParentName
      Debug.Print "Current child: " & strThisChild
      rstTarget.AddNew
      rstTarget![ParentID] = ![ParentID]
      rstTarget![Parent] = strParentName
      
      'Add first child to variable
      strChildren = strThisChild & ", "
      Debug.Print "Children: " & strChildren
      lngPrevParent = lngThisParent
      .MoveNext
      
      Do While Not .EOF
         lngThisParent = ![ParentID]
         strParentName = ![ParentName]
         strThisChild = ![FirstName]
         Debug.Print "Current parent: " & strParentName
         Debug.Print "Current child: " & strThisChild
         
         If lngThisParent <> lngPrevParent Then
            'New parent; save strChildren variable to current record
            'and add new record to target table
            Debug.Print "On new parent record"
            strChildren = Left(strChildren, Len(strChildren) - 2)
            Debug.Print "Final Children list: " & strChildren
            rstTarget![Children] = strChildren
            rstTarget.Update
            strChildren = ""
            rstTarget.AddNew
            rstTarget![ParentID] = ![ParentID]
            rstTarget![Parent] = strParentName
            'Add first child to variable
            strChildren = strThisChild & ", "
         ElseIf lngThisParent = lngPrevParent Then
            'Same parent; add next child to variable
            Debug.Print "On new record for same parent"
            strChildren = strChildren & strThisChild & ", "
            Debug.Print "Children: " & strChildren
         End If
         lngPrevParent = lngThisParent
         .MoveNext
      Loop
      
      'Special processing for last record
      strChildren = Left(strChildren, Len(strChildren) - 2)
      rstTarget![Children] = strChildren
      rstTarget.Update
      .Close
      rstTarget.Close
   End With
   
ErrorHandlerExit:
   Exit Function

ErrorHandler:
   MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
   Resume ErrorHandlerExit

End Function

Select allOpen in new window

http://www.helenfeddema.com/Files/accarch89.zip

Try this: Check and report back. Does CustNum field order the records?
Assume your table name: Before
Add a field to it called rank As Number

This code populates rank field.

Private Sub Command0_Click()
    Dim rs As Recordset
    Dim g As Integer ' group for each LastName
    Dim r As Integer 'records per LastName
    Dim c As Integer ' columns per record
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM Before ORDER BY HouseholdNum,LastName,MiddleName,FirstName")
    rs.MoveFirst
    g = 1
    r = 1
    c = -1
   
    ck1 = rs("HouseholdNum") & rs("LastName")
    Do While Not rs.EOF
        rs.Edit
        If ck1 <> rs("HouseholdNum") & rs("LastName") Then
            g = g + 1
            r = 1
            c = 0
            ck1 = rs("HouseholdNum") & rs("LastName")
        Else
            c = c + 1
            If c > 1 Then
                c = 0
                r = r + 1
            End If
        End If
        rs("rank") = g * 100 + r * 10 + c
        rs.Update
        rs.MoveNext
    Loop
END Sub

Select allOpen in new window

After that run the query with the following sql.

SELECT b.HouseHoldNum, (b1.FirstName & " " & b1.MiddleName & " " & b1.LastName) As FullName1, (b2.FirstName & " " & b2.MiddleName & " " & b2.LastName) As FullName2
FROM (    (SELECT t1.householdnum AS householdnum, t1.rank AS rank1, t2.rank AS rank2 FROM (SELECT HouseholdNum, rank FROM Before WHERE rank mod 2=0)  AS t1 LEFT JOIN (SELECT HouseholdNum, rank FROM Before WHERE rank mod 2=1)  AS t2
 ON LEFT(t1.rank,2)=LEFT(t2.rank,2) )  AS b
 LEFT JOIN Before AS b1 ON b1.rank=b.rank1)
 LEFT JOIN Before AS b2 ON b2.rank=b.rank2
Order By b.HouseHoldNum, b.rank1, b.rank2

Select allOpen in new window

You nailed it, thanks.