Search & Concatenate VBA 1

scubadunc · Sep 11, 2015

Hi there

Can anyone help. I have a database that has name and address details included.

I need to find exact address matches, then combine the recipients names at the same address into one record/field with the following criteria:

2 people with the same surname at same address:

Fname Sname Add
D Marri 12 Colin St
K Marri 12 Colin St

becomes

Fname Sname Add
D & K Marri 12 Colin St

More than 2 people with the same surname at same address:

Fname Sname Add
D Marri 12 Colin St
K Marri 12 Colin St
C Marri 12 Colin St

becomes

Fname Sname Add
The Marri Family 12 Colin St

2 or more people with the different surnames at same address:

Fname Sname Add
D Marri 12 Colin St
L Twight 12 Colin St

becomes

Fname Sname Add
To The Residents 12 Colin St

Firstly is this possible and I hate to ask but would anyone have any code that would achieve this?

Kind regards

Duncan

MajP · Sep 11, 2015

To simplify this I would make a new table and import the results into there. If not you would have to merge and delete records. Would be more complicated.

Here is my table called tblAddress

Code:

[tt]ID	Fname	Lname	address
1	D	Marri	12 Colin St
2	K	Marri	12 Colin St
3	John	Smith	1st Street
4	Joan	Smith	1st Street
5	Brian	Smith	1st Street
6	Mike	Brown	Park Avenue
7	Karen	Black	Park Avenue
8	Bob	Jones	Elm Street[/tt]

I then built a new table called tblAddressNew without any data.

Next built some helper queries
qryDistinctAddresses to get a list of each address

Code:

SELECT DISTINCT tblAddress.address
FROM tblAddress;

address
12 Colin St
1st Street
Elm Street
Park Avenue

qryCountPeopleInHome to get the total count in the home

Code:

SELECT tblAddress.address, Count(tblAddress.Lname) AS PeopleInHome
FROM tblAddress
GROUP BY tblAddress.address;

[tt]address	PeopleInHome
12 Colin St	2
1st Street	3
Elm Street	1
Park Avenue	2[/tt]

qryDistinctNamesInHome to get the distinct list of lastnames

Code:

SELECT DISTINCT tblAddress.Lname, tblAddress.address
FROM tblAddress;

[tt]Lname	address
Black	Park Avenue
Brown	Park Avenue
Jones	Elm Street
Marri	12 Colin St
Smith	1st Street[/tt]

qryCountNamesInHome to get the count of last names in a home

Code:

SELECT qryDistinctNamesInHome.address, Count(qryDistinctNamesInHome.Lname) AS NamesInHome
FROM qryDistinctNamesInHome
GROUP BY qryDistinctNamesInHome.address;

[tt]address	NamesInHome
12 Colin St	1
1st Street	1
Elm Street	1
Park Avenue	2
[/tt]

Now these are referenced in the following code. It reads all the distinct addresses. Then based on the number of people in the home and the number of different last names it determines what to insert into the new table

Code:

Public Sub UpdateAddresses()
  Dim rs As DAO.Recordset
  Dim strSql As String
  Dim address As String
  Dim lastName As String
  Dim firstNameOne As String
  Dim firstNameTwo As String
  Dim numberInHome As Integer
  Dim numberOfNames As Integer
  Dim moreThanOneName As Boolean
  
  
  'Add one distinct address
 ' strSql = "INSERT INTO tblAddressNew ( address ) SELECT DISTINCT tblAddress.address FROM tblAddress"
 ' CurrentDb.Execute strSql
  
  Set rs = CurrentDb.OpenRecordset("qryDistinctAddresses", dbOpenDynaset)
  Do While Not rs.EOF
    address = rs!address
    'need sing quotes
    address = "'" & address & "'"
    numberInHome = DLookup("PeopleInHome", "qryCountPeopleInHome", "address = " & address)
    namesinhome = DLookup("NamesInHome", "qryCountNamesInHome", "address = " & address)

    If numberInHome = 1 Then
      strSql = "INSERT INTO tblAddressNew SELECT tblAddress.* FROM tblAddress WHERE tblAddress.address = " & address
    ElseIf namesinhome > 1 Then
      strSql = "INSERT INTO tblAddressNew (Lname, address) values ('To the Residents'," & address & ")"
    ElseIf numberInHome > 2 Then
      lastName = DLookup("lname", "tblAddress", "address = " & address)
      lastName = "'The " & lastName & " Family'"
      strSql = "INSERT INTO tblAddressNew (Lname, address) values (" & lastName & "," & address & ")"
    ElseIf numberInHome = 2 Then
      lastName = DLookup("lname", "tblAddress", "address = " & address)
      firstNameOne = DLookup("fName", "tblAddress", "address = " & address)
      firstNameTwo = DLookup("fName", "tblAddress", "address = " & address & " AND Fname <> '" & firstNameOne & "'")
      lastName = "'" & firstNameOne & " & " & firstNameTwo & " " & lastName & "'"
      strSql = "INSERT INTO tblAddressNew (Lname, address) values (" & lastName & "," & address & ")"
    End If
    Debug.Print strSql
    CurrentDb.Execute strSql

    rs.MoveNext
  Loop
  
End Sub

Output

Code:

[tt]
Fname	Lname	          address
Bob	Jones	          Elm Street
	To the Residents  Park Avenue
	D & K Marri	  12 Colin St
	The Smith Family  1st Street
[/tt]

scubadunc · Sep 13, 2015

Thank you

What about if my original table structure is

Fname Sname Address1 Address2 Locality state Postcode

and both address fields required comparison

Could you show me the modified code for that schema?

Darrylles · Dec 18, 2015

scuba,

This is called (in the professional world) 'intentional scope-creep' - may I suggest that you try, and tell us how you failed, which we can then advise you on?

This is not a 'get your code free' forum.

ATB,

Darrylle

Never argue with an idiot, he'll bring you down to his level - then beat you with experience.

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Search & Concatenate VBA 1

scubadunc

IS-IT--Management

MajP

Technical User

scubadunc

IS-IT--Management

Darrylles

Programmer

Similar threads

Part and Inventory Search

Sponsor

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Search &amp; Concatenate VBA 1

scubadunc

IS-IT--Management

MajP

Technical User

scubadunc

IS-IT--Management

Darrylles

Programmer

Similar threads

Log in

Part and Inventory Search

Sponsor

Search & Concatenate VBA 1