Concatenated ? Put Colunm data into one cell

[mike]

Hi All

I am looking at the possibility of displaying the results of a query in a
subform but with all the data returned appearing concatenated into one cell.

So the data:-

TblWinnerHistory subform

FdWinnerName
FdYear

Westbury B R
1981

Evercreech
1982

Westbury B R
1983

Westbury B R
1984

Westbury B R
1985

Barnes G
1986

Barnes G
1987

Lennox
1988

Day N A
1992

Day N A
1993

Day N A
1994

Day N A
1995

Bowles K
1998

Wilkes B
1999

Watts D G
2000

Wilkes B
2001

Riddle P
2002

Watts G
2003




Will appear like:-



Westbury B R 1981, Evercreech 1982, Westbury B R 1983, Westbury B R 1984,
Westbury B R 1985, Barnes G 1986, Barnes G 1987, etc etc



I have dabbled with VBA so that is not too much of a problem if someone
could please point me in the right direction on how to achieve this result
please?



Regards

Mike

 

[Tom Wickerath]

Hi Mike,

Try this:
Concatenate fields in same table
http://www.mvps.org/access/modules/mdl0008.htm

or this:
Return a concatenated list of sub-record values
http://www.mvps.org/access/modules/mdl0004.htm

or a function similar to this:

Function BulkEmail() As String
On Error GoTo ProcError

'Return a concatenated string from individual records in a recordset

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim strOut As String
Dim lngLen As Long
Const conSEP = ", "

Set db = CurrentDb()
Set qdf = db.QueryDefs("quniAllRecipients")

qdf![[Forms]![ECN Form]![ECR Number]] = [Forms]![ECN Form]![ECR Number]

Set rs = qdf.OpenRecordset(dbOpenSnapshot)

With rs
Do While Not .EOF
strOut = strOut & !Recipient & conSEP
.MoveNext
Loop
End With

lngLen = Len(strOut) - Len(conSEP)
If lngLen > 0 Then
BulkEmail = left$(strOut, lngLen)
End If

ExitProc:
'Cleanup
If Not rs Is Nothing Then
rs.Close: Set rs = Nothing
End If
Set qdf = Nothing
Set db = Nothing
Exit Function

ProcError:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure BulkEmail..."
Resume ExitProc

End Function


Tom Wickerath
Microsoft Access MVP
http://www.accessmvp.com/TWickerath/
__________________________________________

 

[Tom Wickerath]

PS. I had not remembered modifying my BulkEmail function to include the
querydef or the reference to the form. You probably won't need those extra
complications. Try this version instead:

Option Compare Database
Option Explicit

Function BulkEmail() As String
On Error GoTo ProcError

'Purpose: Return a string containing all the email addresses to mail to.
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strOut As String
Dim lngLen As Long
Const conSEP = ";"

strSQL = "SELECT [ContactName] FROM [Customers] " _
& "WHERE [ContactName] Is Not Null;"

Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)

With rs
Do While Not .EOF
strOut = strOut & ![ContactName] & conSEP
.MoveNext
Loop
End With

lngLen = Len(strOut) - Len(conSEP)

If lngLen > 0 Then
BulkEmail = left$(strOut, lngLen)
End If

Debug.Print BulkEmail

ExitProc:
If Not rs Is Nothing = True Then
rs.Close: Set rs = Nothing
End If
Set db = Nothing
Exit Function

ProcError:
MsgBox Err.Number & ": " & Err.Description, _
vbCritical, "Error in BulkEmail function..."
Resume ExitProc
End Function


Tom Wickerath
Microsoft Access MVP
http://www.accessmvp.com/TWickerath/
__________________________________________

:

Hi Mike,

Try this:
Concatenate fields in same table
http://www.mvps.org/access/modules/mdl0008.htm

or this:
Return a concatenated list of sub-record values
http://www.mvps.org/access/modules/mdl0004.htm

or a function similar to this:

Function BulkEmail() As String
On Error GoTo ProcError

'Return a concatenated string from individual records in a recordset

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim strOut As String
Dim lngLen As Long
Const conSEP = ", "

Set db = CurrentDb()
Set qdf = db.QueryDefs("quniAllRecipients")

qdf![[Forms]![ECN Form]![ECR Number]] = [Forms]![ECN Form]![ECR Number]

Set rs = qdf.OpenRecordset(dbOpenSnapshot)

With rs
Do While Not .EOF
strOut = strOut & !Recipient & conSEP
.MoveNext
Loop
End With

lngLen = Len(strOut) - Len(conSEP)
If lngLen > 0 Then
BulkEmail = left$(strOut, lngLen)
End If

ExitProc:
'Cleanup
If Not rs Is Nothing Then
rs.Close: Set rs = Nothing
End If
Set qdf = Nothing
Set db = Nothing
Exit Function

ProcError:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure BulkEmail..."
Resume ExitProc

End Function

 

[mike]

Thanks you that was a great link!