Solved ConcatRelated Issue (1 Viewer)

[EzGoingKev]

I am using Allen Browne's code here.

In several queries I am concatenating data from tables/other queries and the data I want to concatenate is in there multiple times. To do it in one step I changed Allen's code here:

strSql = "SELECT " & strField & " FROM " & strTable

to this

strSql = "SELECT DISTINCT" & strField & " FROM " & strTable

It has been working fine for years. Now I have to concatenate some data and it has to ordered by two fields. I added the two field names into my ConcatRelated statement and got an error when I went to run the query - Error 3093: ORDER BY clause ([First Field Name]) conflicts with DISTINCT.

I removed the DISTINCT from Allen's code and the query runs fine. Everything is in order. Now when I run the other queries I have dups in the concatenated field.

My level of knowledge gives me two solutions.

#1 - Keep Allen's code SELECT and not SELECT DISTINCT. To keep from getting dups I would first need to do a query that outputs distinct values. Then concatenate off the query.

#2 - Set up two functions with Allen's code, one with SELECT and one with SELECT DISTINCT to make ConcatRelated and ConcatRelatedDistinct functions. The situation would dictate which one I would use.

You guys have A LOT more knowledge than I do. Is there another easier solution?

 

[theDBguy]

Hi. Just thinking out loud, but you might try using a subquery with this simpler function.

Code Snippets

 

[EzGoingKev]

Hi. Just thinking out loud, but you might try using a subquery with this simpler function.

Code Snippets

So that would be like running a query that selects distinct values without actually creating the query?

Also, how would you use that with Allen's code?

 

[MajP]

These functions are great if you do not understand how to write that code. If you know how to write that code then IMO it is often a lot easier to roll your own for each case especially if you want to do something specific. Which is probably against most other things I do, where I do try to write reusable generic code.
So I would have two concat functions in your case.
If you have to pass in a sql string that can get tricky, or if you have to follow Allen browne's that may be limiting. What if you want to concat multiple fields (date and description; date and description?

So this example is from another thread. It is specific for complaints but easy to use since I just pass in an ID. They all follow pretty much the same format.

Public Function ConcatComplaints(CustID As Variant) As String
  Dim rs As DAO.Recordset
  If Not IsNull(CustID) Then
    Set rs = CurrentDb.OpenRecordset("select * from tblComplaints where customerID = " & CustID)
    Do While Not rs.EOF
      If ConcatComplaints = "" Then
        ConcatComplaints = rs!ComplaintDate
      Else
         ConcatComplaints = ConcatComplaints & "; " & rs!ComplaintDate
      End If
      rs.MoveNext
    Loop
  End If
End Function

That example is not that great because I did not do anything that could not be done with the generic. But say I wanted to order by two fields
Set rs = CurrentDb.OpenRecordset("select * from tblComplaints where customerID = " & CustID & " ORDER BY FullName, ComplaintDate DESC")
or concat multi fields
ConcatComplaints = ConcatComplaints & "; " Rs!ComplaintDate & " | " & RS!FullName

 

[Uncle Gizmo]

There's a couple of examples on my website here, along with code and video explanations which may be of interest:-

Display Field Data Horizontally - Nifty Access

Transform, Concatenate Examples A common requirement in MS Access is to extract Columnar data into horizontal data, for instance to make reports look better, to provide a list of emails suitable to send to with Outlook. In the YouTube videos below I explain how this can be done. Display Field...

www.niftyaccess.com

 

[bastanu]

Another one on my site here (allows for concatenating multiple fields) - JoinFromArray: http://forestbyte.com/vba-code-samples/

Cheers,

 

[theDBguy]

So that would be like running a query that selects distinct values without actually creating the query?

Also, how would you use that with Allen's code?

Wait, let's back up a bit. I just tried to run something like

SELECT DISTINCT ID FROM TableName ORDER BY ID

expecting the error you mentioned, but it ran fine. Can you please post the query you tried to use that produced the error? Thanks.

 

[arnelgp]

if Distinct is causing you problem, you can modify the CancatRelat function
to accept boolean value (bolUniqueValuesOnly, the last parameter).
Then use a Table/Query or a Simple select statement:

' USAGE:
' SELECT CompanyName,  ConcatRelated("OrderDate", "tblOrders", "CompanyID = " & [CompanyID])
' FROM tblCompany;
' modified ConcatRelated
' orig by Allen Browne
'
' modified by arnelgp
' for https://www.access-programmers.co.uk/forums/threads/concatrelated-issue.320810/
' add Unique values
'
Public Function ConcatRelated(ByVal strField As String, _
                        ByVal strTable As String, _
                        Optional ByVal strWhere As String = "", _
                        Optional ByVal strOrderBy As String = "", _
                        Optional ByVal strSeparator = ", ", _
                        Optional ByVal bolUniqueValuesOnly As Boolean = False) 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.Recordset2         'Related records
    Dim rsMV As DAO.Recordset2       '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.
   
    'arnelgp
    Dim arrValues() As Variant
    Dim dictValues As Object
    Dim i As Integer
   
    'arnelgp
    'create new dictionary object
    Set dictValues = CreateObject("Scripting.Dictionary")
    'Initialize to Null
    ConcatRelated = Null
    'Build SQL string, and get the records.
   
    If left$(strTable, 6) = "SELECT" Then
        ' arnelgp
        ' you can pass an SQL string now instead of table/query
        strSql = "SELECT [" & strField & "] FROM (" & strTable & ")"
    Else
        strSql = "SELECT [" & strField & "] FROM " & strTable
    End If
    ' arnelgp
    ' clean SQL string
    strSql = Replace$(strSql, ";", vbNullString)
    strSql = Replace$(strSql, "[[", "[")
    strSql = Replace$(strSql, "]]", "]")
    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
                    ' arnelgp
                    If bolUniqueValuesOnly Then
                        If dictValues.Exists(rsMV(0) & "") = False Then
                            dictValues.Add key:=rsMV(0) & "", Item:=rsMV(0).value
                        End If
                    Else
                        i = i + 1
                        dictValues.Add key:=i & "", Item:=rsMV(0).value
                    End If
                    'strOut = strOut & rsMV(0) & strSeparator
                End If
                rsMV.MoveNext
            Loop
            Set rsMV = Nothing
        ElseIf Not IsNull(rs(0)) Then
            ' arnelgp
            If bolUniqueValuesOnly Then
                If dictValues.Exists(rs(0) & "") = False Then
                    dictValues.Add key:=rs(0) & "", Item:=rs(0).value
                End If
            Else
                i = i + 1
                dictValues.Add key:=i & "", Item:=rs(0).value
            End If
            'strOut = strOut & rs(0) & strSeparator
        End If
        rs.MoveNext
    Loop
    rs.Close
    ' arnelgp
    i = dictValues.count
    If i <> 0 Then
        ReDim arrValues(dictValues.count - 1)
        Dim Items As Variant
        Items = dictValues.Items
        For i = 0 To UBound(Items)
            arrValues(i) = Items(i)
        Next
        ConcatRelated = Join(arrValues, strSeparator)
    End If
   
    '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 dictValues = Nothing
    Erase arrValues
    Set rsMV = Nothing
    Set rs = Nothing
    Exit Function

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

 

[sxschech]

To contribute to the discussion adding improvements to the function if encountering error 3061.

I recently had an issue with the concatrelated not working on a query. After a search, learned that as written it doesn't handle referring to values passed from a form. A search turned up the following which makes a slight modification to the code allowing the use of parameters or using values from a form. After I modified the code per the instructions, the concat related worked properly.

ConcatRelated() function, as posted by Allen Browne, uses DAO to open a recordset on the table or query it is passed, without attempting to fill in any parameters. That's why you get error 3061, "Too few parameters."

https://answers.microsoft.com/en-us/msoffice/forum/all/ms-access-trying-to-get-concatrelated-function-to/56a90555-7080-446a-88e5-8bba8eb5955b?page=1

See the 6th posted response dated 15-Jun-2018 from Dirk Goldgar. I have not copied his response here since he mentions he wasn't comfortable including the original code, so wouldn't want to do the same to him.

I'm not comfortable posting Allen's code directly -- it's better to refer to his website -- so I'll post instructions for modifying the code

After I get back the data, if there are duplicates, I run it through this function:

Function RemoveDupes2(txt As String, Optional delim As String = " ") As String
'Remove duplicate repeating multiple words from string
'https://www.extendoffice.com/documents/excel/2133-excel-remove-duplicate-characters-in-string.html#a2
'20190102
    Dim I
    'Updateby20140924
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For Each I In Split(txt, delim)
            If Trim(I) <> "" And Not .Exists(Trim(I)) Then .Add Trim(I), Nothing
        Next
        If .Count > 0 Then RemoveDupes2 = Join(.Keys, delim)
    End With
End Function

A simple example in the immediate window:

? removedupes2("ABC, CBS, ABC, NBC, NBC, CBS, YYZ",", ")
ABC, CBS, NBC, YYZ

 

[EzGoingKev]

Wait, let's back up a bit. I just tried to run something like

SELECT DISTINCT ID FROM TableName ORDER BY ID

expecting the error you mentioned, but it ran fine. Can you please post the query you tried to use that produced the error? Thanks.

See attached.

 

[EzGoingKev]

@arnelgp - I tried the code you posted and got: Compile error: Argument not optional.

It opened the code window and ConcatRelated in the portion of the code below was selected:

    'arnelgp
    'create new dictionary object
    Set dictValues = CreateObject("Scripting.Dictionary")
    'Initialize to Null
    ConcatRelated = Null
    'Build SQL string, and get the records.

 

[theDBguy]

See attached.

Would using it this way help?

    strSQL = "SELECT DISTINCTROW " & strField & " FROM " & strTable

 

[sxschech]

If the distinct is causing issues, try the removedupes2 function from post #9 after you get your results instead of using Distinct.

 

[MajP]

Seems it would be a lot easier using the code posted by @theDBguy. The code is simpler to use and more flexible (can do things like [first] & " " & [LastName] and easily handle the distinct or even a group by).

 

[EzGoingKev]

Would using it this way help?

    strSQL = "SELECT DISTINCTROW " & strField & " FROM " & strTable

It does not work. The query runs without errors but it does not remove the duplicate values.

See SampleData2 and the sample2 query.

 

[MajP]

I get that you want to use the function, but I just find it so much easier to roll your own. Once you do it once it is simple to create new ones. It is ten times easier to call

Public Function GetMakeModel(PartNo As Variant) As String
  Dim rs As DAO.Recordset
  Dim strSql As String
  Dim rtn As String
  If Not IsNull(PartNo) Then
    strSql = "SELECT [Make] & ' ' & [model] AS MakeMod FROM SampleData1 WHERE SampleData1.PartNo = '" & PartNo & "' GROUP BY [Make] & ' ' & [model] ORDER BY [Make] & ' ' & [model]"
    Set rs = CurrentDb.OpenRecordset(strSql)
    Do While Not rs.EOF
      If rtn = "" Then
        rtn = rs!makemod
      Else
        rtn = rtn & "; " & rs!makemod
      End If
      rs.MoveNext
    Loop
    GetMakeModel = rtn
  End If
End Function
Public Function GetArtist(GroupName As Variant) As String
  Dim rs As DAO.Recordset
  Dim strSql As String
  Dim rtn As String
  If Not IsNull(GroupName) Then
    strSql = "SELECT MemberName FROM SampleData2 WHERE GroupName = '" & GroupName & "' GROUP BY [MemberName] ORDER BY MemberName"
    Set rs = CurrentDb.OpenRecordset(strSql)
    Do While Not rs.EOF
      If rtn = "" Then
        rtn = rs!MemberName
      Else
        rtn = rtn & "; " & rs!MemberName
      End If
      rs.MoveNext
    Loop
    GetArtist = rtn
  End If
End Function

So I write all these concats so I can test them in the immediate window
debug.print getMakeModel('1')
and the call in sql is
Select getMakeModel([PartNo]) as Concat

 

[CJ_London]

you just need select distinct

your sample1 query is

SELECT DISTINCT SampleData1.PartNo, ConcatRelated("[AppsCondensed]","[SampleData1]","[PartNo] = """ & [PartNo] & """","[Make],[Model]") AS AppsConcat, Sum(SampleData1.SumOfpolk1) AS SumOfSumOfpolk1
FROM SampleData1
GROUP BY SampleData1.PartNo, ConcatRelated("[AppsCondensed]","[SampleData1]","[PartNo] = """ & [PartNo] & """","[Make],[Model]");

it should be

SELECT DISTINCT SampleData1.PartNo, ConcatRelated("[AppsCondensed]","[SampleData1]","[PartNo] ='" & [PartNo] & "' and [Make]='" & [Make] & "'") AS AppsConcat, Sum(SampleData1.SumOfpolk1) AS SumOfSumOfpolk1
FROM SampleData1
GROUP BY SampleData1.PartNo, ConcatRelated("[AppsCondensed]","[SampleData1]","[PartNo] ='" & [PartNo] & "' and [Make]='" & [Make] & "'");

Note the where parameter of concatrelated - you have
"[PartNo] = """ & [PartNo] & """","[Make],[Model]"

it should be
"[PartNo] ='" & [PartNo] & "' and [Make]='" & [Make] & "'"

aside from the fact you are trying to compare make with model, you really need to learn how to build query strings

 

[arnelgp]

i rename the function as ConcatField()
see query1.

 

[EzGoingKev]

@arnelgp - thanks. It works great.

@CJ_London - you need to go here and read Mr. Brown's instructions so you fully understand what each part of my ConcatRelated statement does.

 

[CJ_London]

I am fully aware of the function. Thought what you were trying to acheive was this

sample1a sample1a

PartNo	AppsConcat	SumOfSumOfpolk1
1	16-15 Ford F-250 Super Duty 6.7L; 16-15 Ford F-350 Super Duty 6.7L; 16-15 Ford F-450 Super Duty 6.7L	42456.2072753906​
10	19-17 Ford Escape 1.5L; 20-14 Ford Fusion 1.5L	154380.187988281​
11	2017 Ford F-150 3.5L	18379.9743652344​
12	2017 Ford F-150 3.5L	18379.9743652344​
13	21-15 Ford Mustang 2.3L	33097.8393554688​
14	19-16 Ford Explorer 2.3L	16030.7312011719​
2	19-16 Ford F-250 Super Duty 6.7L; 19-16 Ford F-350 Super Duty 6.7L; 19-16 Ford F-450 Super Duty 6.7L	99952.5451660156​
3	19-17 Ford F-350 Super Duty 6.7L; 19-17 Ford F-450 Super Duty 6.7L; 19-17 Ford F-550 Super Duty 6.7L	23025.5126953125​
4	17-15 Ford F-150 2.7L	58655.5480957031​
5	17-15 Ford F-150 2.7L	58655.5480957031​
6	18-15 Ford Edge 2.7L; 19-17 Ford Fusion 2.7L	7156.3720703125​
6	18-16 Lincoln MKX 2.7L; 20-17 Lincoln Continental 2.7L	5469.51293945313​
7	18-15 Ford Edge 2.7L; 19-17 Ford Fusion 2.7L	7156.3720703125​
7	18-16 Lincoln MKX 2.7L; 20-17 Lincoln Continental 2.7L	5469.51293945313​
8	20-18 Ford F-150 2.7L	73377.3803710938​
9	20-18 Ford F-150 2.7L	73377.3803710938​