Related field concatenation on two levels

[Gingerale75]

Hello All,

I'm quite new on Access, however I have basic knowledge of queries, etc. also on VBA.

I need to concatenate related fields, but not only on one level (which can be done with Allen Browne's code) but on two levels.

The source table looks like this:

ID    Type    Line   Text
100   Action  1      ccc
100   Action  2      CCC
100   Probl   1      aaa
100   Probl   2      AAA
100   Cause   1      bbb
100   Cause   2      BBB
100   Use     1      12
110   Action  1      zzz
110   Probl   1      xxx
110   Probl   2      XXX
110   Cause   1      yyy
110   Use     1      3
120   Action  1      kkk
120   Action  2      KKK

Note: it's unknown that how many lines are there for the same ID & Type but in the current database it not more than 10.
Type "Use" not required, hence can be ignored, also there are "ID"s where not all four "Type" is present.
After the first conversion the table should look like:

ID    Type    Text
100   Action  ccc, CCC
100   Probl   aaa, AAA
100   Cause   bbb, BBB
110   Action  zzz
110   Probl   xxx, XXX
110   Cause   yyy
120   Action  kkk, KKK

Desired final result:

ID    Text
100   Probl: aaa, AAA; Cause: bbb, BBB; Action: ccc, CCC
110   Probl: xxx, XXX; Cause: yyy; Action: zzz
120   Action: kkk, KKK

Note: the order of the "Types" changed in the final text field compared how they were in the original table.

For the first conversion step I tried to modify Allen Browne's code (sorry, cant make it as a link because I don't have enough posts yet) with adding another parameter (strWhere2) to the function at the declaration section, further down modifying the SQL string creation, and also adding the additional parameter in the Query Expression, but when I run the query it gives an error saying "Too few parameters. Expected: 1"

My modification looks like:

Public Function ConcatRelatedUSA(strField As String, _
    strTable As String, _
    Optional strWhere1 As String, _
    [U][B]Optional strWhere2 As String, _[/B][/U]
    Optional strOrderBy As String, _
    Optional strSeparator = " ") As Variant
 
and further down.....
 
    If strWhere1 <> vbNullString And strWhere2 <> vbNullString Then
        strSql = strSql & " WHERE ((" & strWhere1 & ") AND (" & strWhere2 & "))"
    End If

but got the error on this line:

    Set rs = DBEngine(0)(0).OpenRecordset(strSql, dbOpenDynaset)

Of course the conversion not necessary need to be done in two steps, can be done directly.
Can anybody help me how to modify the VBA code to work, and also what expression should type into the query.

Thank you.

 

[CJ_London]

what is 'the' error?

suggest you put

debug.print strsql

just before the 'set rs' line and show us what that looks like. (debug.print will put the string in the immediate window which you can then copy/paste to this thread

 

[Gingerale75]

what is 'the' error?

suggest you put

debug.print strsql

just before the 'set rs' line and show us what that looks like. (debug.print will put the string in the immediate window which you can then copy/paste to this thread

Thanks for your reply.

In the meantime I think I figured out why I got the message during the first conversion.
In the query expression I need to write the following:

ConcatRelated([Text], [tblName], "ID = " & [ID], "Type = " & [Type])

which is translated by the VBA code to...

ConcatRelated([Text], [tblName], "ID = 100", "Type = Action")

I think it fails because the fourth parameter (Type) is text field and if access need to compare texts then it should be placed between " marks.

But to do that then the expression should be translated by the VBA to:

ConcatRelated([Text], [tblName], "ID = 100", "Type = "Action"")

And it fails because the double " marks and it somehow understood by Access/VBA that one parameter is missing.

My workaround was that I created a query which replaces the Type field text to numeric value (1, 2, 3) and then the second query can concatenate them the Text records, creating this table:

ID    Text1               Text2              Text3
100   Probl: aaa, AAA     Cause: bbb, BBB    Action: ccc, CCC
110   Probl: xxx, XXX     Cause: yyy         Action: zzz
120   Action: kkk, KKK

And then a third query merging the columns with simple expression also taking care to change the order of the texts:
"Probl: " & Text3 & "; Cause: " & Text1 & "; Action: " & Text2

resulting...

ID    Text
100   Probl: aaa, AAA; Cause: bbb, BBB; Action: ccc, CCC
110   Probl: xxx, XXX; Cause: yyy; Action: zzz
120   Action: kkk, KKK

 

[MajP]

Public Function Concat2(ID As Long) As String
  Dim rs As DAO.Recordset
  Dim rs2 as dao.recordset
  Dim rsType As DAO.Recordset
  Const tableName = "tblActions"
  Dim firstLine As Boolean
 
  Set rs2 = CurrentDb.OpenRecordset("Select Distinct Type from " & tableName & " where ID = " & ID)
  Do While Not rs2.EOF
    Set rs = CurrentDb.OpenRecordset("Select * from " & tableName & " where ID = " & ID & " AND TYPE = '" & rs2!Type & "'")
      firstLine = True
      Do While Not rs.EOF
        If firstLine Then
          If Right(Concat2, 2) = ", " Then Concat2 = Left(Concat2, Len(Concat2) - 2) & "; "
          Concat2 = Concat2 & rs!Type & ": " & rs![Text] & ", "
        Else
          Concat2 = Concat2 & rs![Text] & ", "
        End If
        firstLine = false
        rs.MoveNext
      Loop
    rs2.MoveNext
  Loop
  If Right(Concat2, 2) = ", " Then Concat2 = Left(Concat2, Len(Concat2) - 2)
End Function

 

[MajP]

This works with all your formatting. But rs2 needs to be based on a query that sorts Type on a type sort order.

 

[pbaldy]

Post 4 was moderated, I'm posting to trigger email notifications.

 

[June7]

And another version customized for your situation:

Public Function MyConcat(lngID As Long) As Variant
On Error GoTo Err_Handler
    Dim rs As DAO.Recordset
    Dim strSql As String
    Dim strOut As String
    Dim strType As String
    Dim strText As String
    Dim x As Integer
    
    'Initialize to Null
    MyConcat = Null

    'Build SQL string, and get the records.
    strSql = "SELECT * FROM Table1 WHERE ID = " & lngID & " AND [Type] <> 'Use' ORDER BY ID, [Type] DESC, [Text]"
    Set rs = CurrentDb.OpenRecordset(strSql, dbOpenDynaset)
    If Not rs.EOF Then
        strType = rs!Type
        'Loop through matching records
        For x = 1 To rs.RecordCount
            strText = strText & rs!Text & ", "
            If x < rs.RecordCount Then rs.MoveNext
            If strType <> rs!Type Or x = rs.RecordCount Then
                strOut = strOut & strType & ": " & Left(strText, Len(strText) - 2) & "; "
                strType = rs!Type
                strText = ""
            End If
        Next
        rs.Close
        'Return the string without the trailing separator.
        MyConcat = Left(strOut, Len(strOut) - 2)
    End If
    
Exit_Handler:
    'Clean up
    Set rs = Nothing
    Exit Function

Err_Handler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "ConcatRelated()"
    Resume Exit_Handler
End Function

 

[arnelgp]

using Allen Browne's concatRelated() function.

SELECT DISTINCT [yourTableNameHere].ID, 
("Problem: " + ConcatRelated("Text","[yourTableNameHere]","ID=" & [ID] & " And Type='Probl'") + "; ") & 
("Cause: " + ConcatRelated("Text","[yourTableNameHere]","ID=" & [ID] & " And Type='Cause'") + "; ") & 
("Action: " + ConcatRelated("Text","[yourTableNameHere]","ID=" & [ID] & " And Type='Action'")) AS [Text]
FROM [yourTableNameHere];

Public Function ConcatRelated(strField As String, _
    strTable As String, _
    Optional strWhere As String, _
    Optional strOrderBy As String, _
    Optional strSeparator = ", ") As Variant
On Error GoTo err_handler
    'Purpose:   Generate a concatenated string of related records.
    'Return:    String variant, or Null if no matches.
    'Arguments: strField = name of field to get results from and concatenate.
    '           strTable = name of a table or query.
    '           strWhere = WHERE clause to choose the right values.
    '           strOrderBy = ORDER BY clause, for sorting the values.
    '           strSeparator = characters to use between the concatenated values.
    'Notes:     1. Use square brackets around field/table names with spaces or odd characters.
    '           2. strField can be a Multi-valued field (A2007 and later), but strOrderBy cannot.
    '           3. Nulls are omitted, zero-length strings (ZLSs) are returned as ZLSs.
    '           4. Returning more than 255 characters to a recordset triggers this Access bug:
    '               http://allenbrowne.com/bug-16.html
    Dim rs As DAO.Recordset         'Related records
    Dim rsMV As DAO.Recordset       'Multi-valued field recordset
    Dim strSQL As String            'SQL statement
    Dim strOut As String            'Output string to concatenate to.
    Dim lngLen As Long              'Length of string.
    Dim bIsMultiValue As Boolean    'Flag if strField is a multi-valued field.
    
    'Initialize to Null
    ConcatRelated = Null
    
    'Build SQL string, and get the records.
    strSQL = "SELECT " & strField & " FROM " & strTable
    If strWhere <> vbNullString Then
        strSQL = strSQL & " WHERE " & strWhere
    End If
    If strOrderBy <> vbNullString Then
        strSQL = strSQL & " ORDER BY " & strOrderBy
    End If
    Set rs = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenDynaset)
    'Determine if the requested field is multi-valued (Type is above 100.)
    bIsMultiValue = (rs(0).type > 100)
    
    'Loop through the matching records
    Do While Not rs.EOF
        If bIsMultiValue Then
            'For multi-valued field, loop through the values
            Set rsMV = rs(0).value
            Do While Not rsMV.EOF
                If Not IsNull(rsMV(0)) Then
                    strOut = strOut & rsMV(0) & strSeparator
                End If
                rsMV.MoveNext
            Loop
            Set rsMV = Nothing
        ElseIf Not IsNull(rs(0)) Then
            strOut = strOut & rs(0) & strSeparator
        End If
        rs.MoveNext
    Loop
    rs.Close
    
    'Return the string without the trailing separator.
    lngLen = Len(strOut) - Len(strSeparator)
    If lngLen > 0 Then
        ConcatRelated = Left(strOut, lngLen)
    End If

exit_handler:
    'Clean up
    Set rsMV = Nothing
    Set rs = Nothing
    Exit Function

err_handler:
    MsgBox "Error " & Err.Number & ": " & Err.description, vbExclamation, "ConcatRelated()"
    Resume exit_handler
End Function

 

[Gingerale75]

Hello All,

Thanks for all your help, at the end I used the last solution from 'arnelgp' in Post #8 as it is not require another VBA function to introduce.

Only one more question left, but I'm not sure if it's the right thread for it.

The tables which included in the query are ODBC tables.
If I run the query for the first time after opened Access, as usual, it asks for the Username & Password once.
However if I run the query second time (without closing Access) it asks for the user/pass many times, I guess it would keep going like that for every record/field checked.... which is obviously a big NO having approx 400,000 records in the ODBC table... and I can't stop the loop even if I press Debug Stop in VBA... I need to kill the Access process from Windows Task Manager to stop it.

I tried to create the link to the ODBC with saved user/pass, but it still asks for it.

Any idea?

 

[arnelgp]

consider using a DSN-less connection.
https://support.microsoft.com/en-us...connection-to-sql-server-for-linked-tables-in