[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 191
  • Last Modified:

Query to consolidate records

I need a query that will take me from BEFORE to AFTER as illustrated in the attached file so I can reduce the number of mailings in a mailing list. There can be a maximum of two FullNames per record but the last names must match. Household numbers must also match.
Example.xlsx
0
K_Deutsch
Asked:
K_Deutsch
  • 3
1 Solution
 
Helen FeddemaCommented:
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.
0
 
Helen FeddemaCommented:
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

Open in new window

http://www.helenfeddema.com/Files/accarch89.zip
0
 
hnasrCommented:
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

Open 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

Open in new window

0
 
Helen FeddemaCommented:
This code will do the job:
Public Sub FillOutputTable()
'Created by Helen Feddema 25-Jul-2014
'Last modified by Helen Feddema 25-Jul-2014

On Error GoTo ErrorHandler

   Dim rstSource As DAO.Recordset
   Dim rstTarget As DAO.Recordset
   Dim strFullName As String
   Dim strFullName1 As String
   Dim strFullName2 As String
   Dim strLastName As String
   Dim strPrevLastName As String
   Dim strQuery As String
   Dim strSearch As String
   Dim strSQL As String
   Dim strTable As String
   Dim strThisLastName As String
   Dim lngOutputID As Long
   Dim lngLastNameCount As Integer
   
   strQuery = "qryInput"
   strTable = "tblOutput"
   
   'Clear old target table
   strSQL = "DELETE * FROM " & strTable
   DoCmd.SetWarnings False
   CurrentDb.Execute strSQL, dbFailOnError
   
   Set rstSource = CurrentDb.OpenRecordset(strQuery, dbOpenDynaset)
   Set rstTarget = CurrentDb.OpenRecordset(strTable, dbOpenDynaset)
   strPrevLastName = ""
   lngLastNameCount = 1
   
   With rstSource
       Do While Not .EOF
         strThisLastName = ![LastName]
         strFullName = ![FullName]
         Debug.Print "Current LastName: " & strThisLastName
         Debug.Print "Current FullName: " & strFullName
         
         If strThisLastName <> strPrevLastName Then
            'New LastName
            Debug.Print "On new LastName record"
            With rstTarget
               .AddNew
               ![FullName1] = strFullName
               lngOutputID = ![OutputID]
               .Update
            End With
            
            Debug.Print "Current LastNameCount: " & lngLastNameCount
            
         ElseIf strThisLastName = strPrevLastName Then
           'Same LastName
            Debug.Print "On another record for same last name"
            
            If lngLastNameCount Mod 2 = 0 Then
               With rstTarget
                  strSearch = "[OutputID] = " & lngOutputID
                  Debug.Print "Search string: " & strSearch
                  .FindFirst strSearch
                  If .NoMatch = False Then
                     Debug.Print "Writing " & strFullName & " to FullName2 field in " _
                        & "OutputID " & lngOutputID & " record"
                     .Edit
                     ![FullName2] = strFullName
                     lngOutputID = ![OutputID]
                     .Update
                  End If
               End With
            Else
               With rstTarget
               Debug.Print "Adding new output record for " & strFullName
                  .AddNew
                  ![FullName1] = strFullName
                  lngOutputID = ![OutputID]
                  .Update
               End With
            End If
         End If
         
         lngLastNameCount = lngLastNameCount + 1
         strPrevLastName = strThisLastName
         .MoveNext
      Loop
   End With
   
   rstSource.Close
   rstTarget.Close
   Set rstSource = Nothing
   Set rstTarget = Nothing
   
ErrorHandlerExit:
   Exit Sub

ErrorHandler:
   MsgBox "Error No: " & Err.Number _
      & " in FillOutputTable procedure; " _
      & "Description: " & Err.Description
   Resume ErrorHandlerExit

End Sub

Open in new window

It is in the attached database.
Test-1.accdb
0
 
K_DeutschAuthor Commented:
You nailed it, thanks.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now