Query (or other method) to compress multiple records to one.

  • Thread starter Thread starter Paul Blay
  • Start date Start date
P

Paul Blay

I couldn't really fit a good description in the subject for this one ...

Basically assume you have some table like this.

Name Job
======+===============
Fred | Photocopying
Fred | Making tea
Mike | Data Entry
Mike | Mail shots

And what you want is something like this

Name Job List
======+==========================
Fred | Photocopying, Making tea
Mike | Data Entry, Mail shots

Or this,

Name Job One Job Two
======+==============+============
Fred | Photocopying | Making tea
Mike | Data Entry | Mail shots

(There can be a variable number of 'jobs' per person - but maximum of
six or so, not some unmanagably high number).

Any suggestions?
 
Quoting Duane Hookom

I use a generic Concatenate() function. The code is listed below with both
ADO and DAO. There are comments regarding which lines to comment or
uncomment based on which library you prefer. Access 97 is mostly DAO while
the default for 2000 and newer is ADO.

See:
http://www.rogersaccesslibrary.com/OtherLibraries.asp#Hookom,Duane.

Function Concatenate(pstrSQL As String, _
Optional pstrDelim As String = ", ") As String
'example
'tblFamily with FamID as numeric primary key
'tblFamMem with FamID, FirstName, DOB,...
'return a comma separated list of FirstNames for a FamID
' John, Mary, Susan
'in a Query
'SELECT FamID,
' Concatenate("SELECT FirstName FROM tblFamMem
' WHERE FamID =" & [FamID]) as FirstNames
'FROM tblFamily
'

'======For DAO uncomment next 4 lines========
'====== comment out ADO below ========
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset(pstrSQL)

'======For ADO uncomment next two lines========
'====== comment out DAO above ========
'Dim rs As New ADODB.Recordset
'rs.Open pstrSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

Dim strConcat As String 'build return string
With rs
If Not .EOF Then
.MoveFirst
Do While Not .EOF
strConcat = strConcat & .Fields(0) & pstrDelim
.MoveNext
Loop
End If
.Close
End With
Set rs = Nothing

'====== comment out next line for ADO ===========
Set db = Nothing
If Len(strConcat) > 0 Then
strConcat = Left(strConcat, Len(strConcat) - Len(pstrDelim))
End If
Concatenate = strConcat
End Function
 
Back
Top