Microsoft Access condense multiple lines in a table

Question

I have a question in MS Access 2007 and I hope someone has the answer. I have a long but simple table containing customer names and the days of the week that deliveries are made. I would like to summarize this table by listing the name and all the days into one new field "ALLDays" while still preserving all the data.

The source table looks something like this:

Name         Day  
CustomerA    Monday  
CustomerA    Thursday  
CustomerB    Tuesday  
CustomerB    Friday  
CustomerC    Wednesday  
CustomerC    Saturday  

I would like to have a query which returns results like this:

Name         ALLDays  
CustomerA    Monday, Thursday  
CustomerB    Tuesday, Friday  
CustomerC    Wednesday, Saturday  

Thanks.

Fley

See #1921052 with particular reference to the note on ADODB recordsets. – District

typically, you would use a cross-tab query. Go to the "Create" tab to create query, then Query design for design view. Add table to see the contents. Then select "Design" tab, "Crosstab". – Cis

Answer 1

Typically you have to write a function that will allow you to create a concatenated list. Here's what I've used:.

Public Function GetList(SQL As String _
                            , Optional ColumnDelimeter As String = ", " _
                            , Optional RowDelimeter As String = vbCrLf) As String
'PURPOSE: to return a combined string from the passed query
'ARGS:
'   1. SQL is a valid Select statement
'   2. ColumnDelimiter is the character(s) that separate each column
'   3. RowDelimiter is the character(s) that separate each row
'RETURN VAL: Concatenated list
'DESIGN NOTES:
'EXAMPLE CALL: =GetList("Select Col1,Col2 From Table1 Where Table1.Key = " & OuterTable.Key)

Const PROCNAME = "GetList"
Const adClipString = 2
Dim oConn As ADODB.Connection
Dim oRS As ADODB.Recordset
Dim sResult As String

On Error GoTo ProcErr

Set oConn = CurrentProject.Connection
Set oRS = oConn.Execute(SQL)

sResult = oRS.GetString(adClipString, -1, ColumnDelimeter, RowDelimeter)

If Right(sResult, Len(RowDelimeter)) = RowDelimeter Then
    sResult = Mid$(sResult, 1, Len(sResult) - Len(RowDelimeter))
End If

GetList = sResult
oRS.Close
oConn.Close

CleanUp:
    Set oRS = Nothing
    Set oConn = Nothing

Exit Function
ProcErr:
    ' insert error handler
    Resume CleanUp

End Function

Remou's version has the added feature that you can pass an array of values instead of a SQL statement.

---

Sample query might look like:

SELECT SourceTable.Name
    , GetList("Select Day From SourceTable As T1 Where T1.Name = """ & [SourceTable].[Name] & """","",", ") AS Expr1
FROM SourceTable
GROUP BY SourceTable.Name;

Thoughtless

Btw, I've obviously stripped out the error handler I used which used the PROCNAME constant. – Thoughtless

Thanks very much for your help but i'm fairly new at this and your answer was a bit above my level. Would you kindly give me specifics? My source table is called CustomerRoutes. The two fields are Name and Day. So I create a module and write what exact code? and how exactly do I call the GetList function, I presume I create a new query in SQL mode and write something like Select("Name, Day from...? Thanks. – Fley

@Fley - First, you need to drop the code into a Module. You then create a normal query using the distinct customers in "SourceData" as mentioned in your OP (So, one row per customer). You might need to make that a Group By query. Then, one of the columns in that query you would enter a formula: =GetList("Select Day From SourceData As S1 Where S1.Day = " & SourceData.Col). In this way, you are using a column in the main query to build a Select query in the GetList function. – Thoughtless

@Thoughtless - I get a compile error on this line of the module: Set oConn = '...populate ADO connection. THanks – Fley

@Fley - You would enter your routine for getting the ADO connection. I've amended to include CurrentProject.Connection instead. In my version, I have a function to get the the ADO connection. In addition, I have made a few tweaks to the function and have provided a sample query. – Thoughtless

@David-W-Fenton - The DAO.Recordset object does not implement the GetString method. – Thoughtless

So what if it doesn't implement anything like GetString. The difference is one complicated line of code vs. three lines of a simple loop. Now, if you can show a performance difference between the two, perhaps. But I'd expect GetString takes a long time to retrieve the resultset, but except for very large recordsets (which you won't likely be concatenating, anyway), the difference with walking the recordset should be infinitesimal. – Octahedrite

@Octahedrite - So, I'm able to do it one line of code that is likely to be compiled to binary. If you are going to do with loops, you have to work around VBA's heinous performance with string concatenation. I just don't see any advantage to ferreting out a DAO solution that will be longer and have pitfalls when there is a perfectly fine solution using ADO. – Thoughtless

Well, the main reason is because ADO is not native, and that you shouldn't be using it as your default data access method in an Access application. Yes, it's quite usable with late binding for those things that DAO does not provide, but I don't see the issue here. I know nothing about VBA's performance with string concatenation, but even if it's quite slow compared to the GetString approach, you wouldn't be using this on a recordset with enough records that it would make a real-world difference, seems to me. That is, you won't be concatenating 100,000 values. – Octahedrite

Using this example it cuts off at 255 char length. It is not the method, it returns the full String but the query truncates to 255 chars. Any idea how to make it return the full list? – With

@MartinVerner - That is not a limitation in the GetString function. I suspect that the query from which you are calling the function is truncating the column at 255 characters. There a series of scenarios where a Memo/Long Text field (which is effectively what we want here) gets quietly truncated by Access. This link is quite dated but talks about the same problem which I believe still exists in the current versions of Access: allenbrowne.com/ser-63.html – Thoughtless

+1. Note to readers who get the error user-defined type not defined at Dim oConn As ADODB.Connection: It's because "You need to set a reference to 'Microsoft ActiveX Data Objects' (ADO for short) first. Select Tools -> References. From the dialog box that pops up, scroll down until you find an entry that reads something like Microsoft ActiveX Data Objects 2.7 Library (pick the highest number you see). Check the tick box next to this entry and click ok." Source: p2p.wrox.com/excel-vba/… – Aerodontia

Answer 2

Here is a simple solution that does not require VBA. It uses an update query to concatenate values onto a field.

I'll show it with the example I am using.

I have a table "emails_by_team" that has two fields "team_id" and "email_formatted". What I want is to collect all emails for a given team in one string.

1) I create a table "team_more_info" that has two fields: "team_id" and "team_emails"

2) populate "team_more_info" with all "team_id" from "emails_by_team"

3) create an update query that sets "emails_by_team" to NULL
Query name: team_email_collection_clear

UPDATE team_more_info 
SET team_more_info.team_emails = Null;

4) This is the trick here: create an update a query
Query name: team_email_collection_update

UPDATE team_more_info INNER JOIN emails_by_team 
  ON team_more_info.team_id = emails_by_team.team_id 
SET team_more_info.team_emails = 
    IIf(IsNull([team_emails]),[email_formatted],[team_emails] & "; " & [email_formatted]);

5) to keep the info up-to-date create a macro that runs the two queries whenever needed

First: team_email_collection_clear

Second: team_email_collection_update

QED

Swear

Answer 3

Since this is just a small range of options, another approach with no VBA would be to set up a series of IIF statements and concatenate the results.

SELECT name, 
   IIF(SUM(IIF(day = "Monday",1,0)) >0, "Monday, ") & 
   IIF(SUM(IIF(day = "Tuesday",1,0)) >0, "Tuesday, ") & 
   IIF(SUM(IIF(day = "Wednesday",1,0)) >0, "Wednesday, ") & 
   IIF(SUM(IIF(day = "Thursday",1,0)) >0, "Thursday, ") &
   IIF(SUM(IIF(day = "Friday",1,0)) >0, "Friday, ") &
   IIF(SUM(IIF(day = "Saturday",1,0)) >0, "Saturday, ") &
   IIF(SUM(IIF(day = "Sunday",1,0)) >0, "Sunday, ") AS AllDays
FROM Table1
GROUP BY name

If you a perfectionist, you could even get rid of the last comma like this

SELECT name, 
LEFT(
   IIF(SUM(IIF(day = "Monday",1,0)) >0, "Monday, ") & 
   IIF(SUM(IIF(day = "Tuesday",1,0)) >0, "Tuesday, ") & 
   IIF(SUM(IIF(day = "Wednesday",1,0)) >0, "Wednesday, ") & 
   IIF(SUM(IIF(day = "Thursday",1,0)) >0, "Thursday, ") &
   IIF(SUM(IIF(day = "Friday",1,0)) >0, "Friday, ") &
   IIF(SUM(IIF(day = "Saturday",1,0)) >0, "Saturday, ") &
   IIF(SUM(IIF(day = "Sunday",1,0)) >0, "Sunday, "),
LEN(
   IIF(SUM(IIF(day = "Monday",1,0)) >0, "Monday, ") & 
   IIF(SUM(IIF(day = "Tuesday",1,0)) >0, "Tuesday, ") & 
   IIF(SUM(IIF(day = "Wednesday",1,0)) >0, "Wednesday, ") & 
   IIF(SUM(IIF(day = "Thursday",1,0)) >0, "Thursday, ") &
   IIF(SUM(IIF(day = "Friday",1,0)) >0, "Friday, ") &
   IIF(SUM(IIF(day = "Saturday",1,0)) >0, "Saturday, ") &
   IIF(SUM(IIF(day = "Sunday",1,0)) >0, "Sunday, ")
) - 2
)
AS AllDays
FROM Table1
GROUP BY name

You may also consider keeping them in separate columns, as this may prove more useful if accessing this query from another. For instance, finding only instances with a Tuesday would be easier this way. Something like:

SELECT name, 
IIF(SUM(IIF(day = "Monday",1,0)) >0, "Monday") AS Monday,  
IIF(SUM(IIF(day = "Tuesday",1,0)) >0, "Tuesday") AS Tuesday,
IIF(SUM(IIF(day = "Wednesday",1,0)) >0, "Wednesday") AS Wednesday,
IIF(SUM(IIF(day = "Thursday",1,0)) >0, "Thursday") AS Thursday,
IIF(SUM(IIF(day = "Friday",1,0)) >0, "Friday") AS Friday,
IIF(SUM(IIF(day = "Saturday",1,0)) >0, "Saturday") AS Saturday,
IIF(SUM(IIF(day = "Sunday",1,0)) >0, "Sunday") AS Sunday
FROM Table1
GROUP BY name

Yard

Answer 4

Thomas's GetList function is great, but it was too slow for my large db. I think the slowdown may be caused by the use of ADO, so I rewrote GetList to use native DAO calls.

This version is about 3x faster:

Option Compare Database
Option Explicit

' Concatenate multiple values in a query. From:
' https://mcmap.net/q/469697/-microsoft-access-condense-multiple-lines-in-a-table/5174843#5174843
'
' Note that using a StringBuilder class from here:
' https://codereview.stackexchange.com/questions/67596/a-lightning-fast-stringbuilder/154792#154792
' offers no code speed up

Public Function GetListOptimal( _
    SQL As String, _
    Optional fieldDelim As String = ", ", _
    Optional recordDelim As String = vbCrLf _
    ) As String

    Dim dbs As Database
    Dim rs As Recordset
    Dim records() As Variant
    Dim recordCount As Long

    ' return values
    Dim ret As String
    Dim recordString As String
    ret = ""
    recordString = ""

    ' index vars
    Dim recordN As Integer
    Dim fieldN As Integer
    Dim currentField As Variant

    ' array bounds vars
    Dim recordsLBField As Integer
    Dim recordsUBField As Integer
    Dim recordsLBRecord As Integer
    Dim recordsUBRecord As Integer

    ' get data from db
    Set dbs = CurrentDb
    Set rs = dbs.OpenRecordset(SQL)
    recordCount = rs.recordCount

    ' Guard against no records returned
    If recordCount = 0 Then
        GetListOptimal = ""
        Exit Function
    End If

    records = rs.GetRows(recordCount)

    ' assign bounds of data
    recordsLBField = LBound(records, 1)    ' should always be 0, I think
    recordsUBField = UBound(records, 1)
    recordsLBRecord = LBound(records, 2)    ' should always be 0, I think
    recordsUBRecord = UBound(records, 2)

    ' FYI vba will loop thorugh every For loop at least once, even if
    ' both LBound and UBound are 0.  We already checked to ensure that
    ' there is at least one record, and that also ensures that
    ' there is at least one record.  I think...
    ' Can a SQL query return >0 records with 0 fields each?
    For recordN = recordsLBRecord To recordsUBRecord
        For fieldN = recordsLBField To recordsUBField
            ' Only add fieldDelim after at least one field
            If recordString <> "" Then
                recordString = recordString & fieldDelim
            End If

            ' records is indexed (field, record) for some reason
            currentField = records(fieldN, recordN)

            ' Guard against null-valued fields
            If Not IsNull(currentField) Then
                recordString = recordString & CStr(currentField)
            End If
        Next fieldN

        ' Only add recordDelim after at least one record
        If ret <> "" Then
            ret = ret & recordDelim
        End If
        ret = ret & recordString

        recordString = ""   ' Re-initialize to ensure no old data problems
    Next recordN

    ' adds final recordDelim at end output
    ' not sure when this might be a good idea
    ' TODO: Implement switch parameter to control
    ' this, rather than just disabling it
    ' If ret <> "" Then
    '    ret = ret & recordDelim
    ' End If

    ' Cleanup db objects
    Set dbs = Nothing
    Set rs = Nothing

    GetListOptimal = ret
    Exit Function
End Function

The call signatures are identical, although there are probably edge cases where they give different results.

This version also has the benefit of not requiring you to add a manual reference as MarredCheese pointed out.

Lees

For the above improved solution, small fix. as recordCount will return proper result only when moving to the last record If rs.recordCount > 0 Then rs.MoveLast recordCount = rs.recordCount rs.MoveFirst End If – Vaucluse