In previous Access Archon columns, I have discussed concatenation of dollar amounts (Access Archon #179), or children’s names and school subjects (Access Archon #230).  In this article I discuss a more complex type of concatenation, where concatenation is done for sets of records filtered by three values.

The Form

The sample database, Complex Concatenation, has only one form, frmSelectStaff, with a listbox for selecting staff persons:

Figure A.  The form with a listbox for selecting staff

After selecting one or more staff persons, clicking the Create Work List button runs a Click event procedure, which first checks that at least one staff member has been selected from the listbox, then creates a concatenated string of StaffIDs for the selected staff, which is used to create a filtered query.  Finally, the ConcatenateWorkTypes procedure is called and the rptWorkList report is opened.

Private Sub cmdCreateWorkList_Click()

On Error GoTo ErrorHandler

   Dim lngCount As Long

   Dim lngStaffID As Long

   Dim lst As Access.ListBox

   Dim strFilter As String

   Dim strPrompt As String

   Dim strQuery As String

   Dim strRecordSource As String

   Dim strSQL As String

   Dim strTitle As String

   Dim varItem As Variant

   'Create filter string for selected crews

   Set lst = Me![lstStaff]

   'Check that at least one item has been selected

   If lst.ItemsSelected.Count = 0 Then

      strTitle = "No items selected"

      strPrompt = "Please select at least one staff person"

      MsgBox prompt:=strPrompt, _

         buttons:=vbInformation + vbOKOnly, _

         Title:=strTitle

      lst.SetFocus

      GoTo ErrorHandlerExit

   End If

   For Each varItem In lst.ItemsSelected

      lngStaffID = Nz(lst.Column(0, varItem))

      strFilter = strFilter & "[StaffID] = " & lngStaffID & " Or "

NextItem:

   Next varItem

   If Right(strFilter, 4) = " Or " Then

      strFilter = Left(strFilter, Len(strFilter) - 4)

   End If

   Debug.Print "Filter string: " & strFilter

   strRecordSource = "qryWorkAndStaff"

   strQuery = "qryWorkListSelectedStaff"

   strSQL = "SELECT * FROM " & strRecordSource & " WHERE " _

      & strFilter & ";"

   Debug.Print "SQL for " & strQuery & ": " & strSQL

   lngCount = CreateAndTestQuery(strQuery, strSQL)

   Debug.Print "No. of items found: " & lngCount

   If lngCount = 0 Then

      strPrompt = "No records found for these staff persons; canceling"

      strTitle = "Canceling"

      MsgBox strPrompt, vbOKOnly + vbCritical, strTitle

      GoTo ErrorHandlerExit

   End If

   Call ConcatenateWorkTypes

   DoCmd.OpenReport "rptWorkList", View:=acViewPreview

ErrorHandlerExit:

   Exit Sub

ErrorHandler:

   MsgBox "Error No: " & Err.Number _

      & " in " & Me.ActiveControl.Name & " procedure; " _

      & "Description: " & Err.Description

   Resume ErrorHandlerExit

End Sub

The ConcatenateWorkTypes procedure is listed below.  It uses several recordsets to work with the data.  The first (rstSource1) is based on the filtered query created in the Click event procedure listed above, which filters the raw data for work done by the selected staff persons.  rstTarget is a table that is first cleared, then filled with data for use in the report, while rstWorkTypes is another table that is cleared and refilled with work types for concatenation.  Finally, rstWorkTypesSorted is based on a query that returns alphabetically sorted unique values from tblWorkTypes for each set of records.

After setting starter values for the three fields used for creating sets of data (to ensure that the first record is counted as a new set), the code loops through rstSource1, checking whether the current record has the same values for StaffID, Code and WorkDate as the previous record (or the default values, for the first record).  If any of these values is different, a new set is started, a filter string is created and a filtered query created based on this query, which is then used to create rstSource2, and the code then loops through that recordset and saves the WorkType value from each record to tblWorkTypes, using rstWorkTypes.

Then rstWorkTypesSorted is set, which has unique, alphabetically sorted work types from tblWorkTypes, and the code creates a concatenated string of the sorted work types for this set.  Finally, the StaffID, StaffName, Code, WorkDate and concatenated WorkTypes values are saved to a new record in tblWorkSelectedStaff, and the report based on that table is opened.

Public Sub ConcatenateWorkTypes()

On Error GoTo ErrorHandler

   Dim blnNewSet As Boolean

   Dim dteCurrentWork As Date

   Dim dteWork As Date

   Dim lngCount As Long

   Dim lngCounter As Long

   Dim lngCurrentStaffID As Integer

   Dim lngStaffID As Integer

   Dim rstSource1 As DAO.Recordset

   Dim rstSource2 As DAO.Recordset

   Dim rstTarget As DAO.Recordset

   Dim rstWorkTypes As DAO.Recordset

   Dim rstWorkTypesSorted As DAO.Recordset

   Dim strCode As String

   Dim strCurrentCode As String

   Dim strCurrentWorkType As String

   Dim strFilter As String

   Dim strQuery As String

   Dim strSourceQuery As String

   Dim strSQL As String

   Dim strStaffName As String

   Dim strWorkType As String

   Dim strWorkTypes As String

   strSQL = "DELETE * FROM tblWorkSelectedStaff"

Secrets and tips for the Windows 10 November 2019 update

A detailed and independent look at Windows 10, especially for Microsoft Office.

Fully up-to-date with coverage of the November 2019 major update of Windows 10.

This 1,000 pages, 40 chapter book shows you important features and details for Windows 10 users.

   CurrentDb.Execute strSQL

   strSourceQuery = "qryWorkListSelectedStaff"

   strQuery = "qryWorkTypesPerStaff"

   Set rstSource1 = CurrentDb.OpenRecordset(strSourceQuery, dbOpenDynaset)

   Set rstTarget = CurrentDb.OpenRecordset("tblWorkSelectedStaff")

   Set rstWorkTypes = CurrentDb.OpenRecordset("tblWorkTypes")

   lngStaffID = 0

   strCode = ""

   dteWork = #12:00:00 AM#

   With rstSource1

      Do While Not .EOF

         lngCurrentStaffID = ![StaffID]

         strCurrentCode = ![Code]

         dteCurrentWork = ![WorkDate]

         strWorkType = ![WorkType]

         'Check whether this is a new set or not

         If lngCurrentStaffID = lngStaffID And strCurrentCode = _

            strCode And dteCurrentWork = dteWork Then

            blnNewSet = False

         Else

            blnNewSet = True

            lngStaffID = lngCurrentStaffID

            strCode = strCurrentCode

            dteWork = dteCurrentWork

            strWorkType = ![WorkType]

            strStaffName = ![StaffName]

         End If

         If blnNewSet = True Then

            strFilter = "[StaffID] = " & lngStaffID & " And [Code] = " _

               & Chr(39) & strCode & Chr(39) & " And [WorkDate] = " _

               & Chr(35) & dteWork & Chr(35)

            strSQL = "SELECT * FROM " & strSourceQuery & " WHERE " _

               & strFilter & ";"

            Debug.Print "SQL for " & strQuery & ": " & strSQL

            lngCount = CreateAndTestQuery(strQuery, strSQL)

            Debug.Print "No. of items found for set: " & lngCount

            Set rstSource2 = CurrentDb.OpenRecordset(strQuery)

            'Save Work Types for this set of records to temp table

            strSQL = "DELETE * FROM tblWorkTypes"

            CurrentDb.Execute strSQL

            Do While Not rstSource2.EOF

               strWorkType = rstSource2![WorkType]

               Debug.Print "Current Work Type: " & strWorkType

               rstWorkTypes.AddNew

               rstWorkTypes![WorkType] = strWorkType

               rstWorkTypes.Update

               rstSource2.MoveNext

            Loop

            'Concatenate work types for this set of records

            Set rstWorkTypesSorted = _

               CurrentDb.OpenRecordset("qryWorkTypesSorted")

            strWorkTypes = ""

            With rstWorkTypesSorted

               Do While Not .EOF

                  strWorkType = ![WorkType]

                  strWorkTypes = strWorkTypes & strWorkType & ", "

                  .MoveNext

               Loop

               .Close

            End With

            strWorkTypes = Left(strWorkTypes, Len(strWorkTypes) - 2)

            Debug.Print "Concatenated Work Types: " & strWorkTypes

            With rstTarget

               .AddNew

               ![StaffID] = lngStaffID

               ![StaffName] = strStaffName

               ![Code] = strCode

               ![WorkDate] = dteWork

               ![WorkTypes] = strWorkTypes

               .Update

             End With

         End If

         .MoveNext

      Loop

   End With

ErrorHandlerExit:

   Exit Sub

ErrorHandler:

   MsgBox "Error No: " & Err.Number _

      & " in ConcatenateWorkTypes procedure; " _

      & "Description: " & Err.Description

   Resume ErrorHandlerExit

End Sub

The report is shown below:

Figure B.  The report with concatenated work types per StaffID, Code and WorkDate

References

The code in the sample database needs the following references (in addition to the default references):

Microsoft Word 14.0 Object Library (for SortDeclarations procedure only)

Microsoft Forms 2.0 Object Library (for SortDeclarations procedure only)

If you import code or objects into a database of your own, you may need to set one or more of these references.  The version number may differ, depending on your Office version; check the version you have.  References are set in the References dialog, opened from the VBA window.  For more information on working with references, see Access Archon #107, Working with References.

Supporting Files

The zip file containing this article, in Word 97-2003 format, plus the supporting file(s), may be downloaded from the Access Archon page of my Web site, as accarch241.zip, which is the last entry in the table of Access Archon columns for Access Watch.

Latest news & secrets of Microsoft Office

Microsoft Office experts give you tips and help for Word, Excel, PowerPoint and Outlook.

Give it a try. You can unsubscribe at any time.  Office Watch has been running for over 20 years, we've never, ever revealed or sold subscriber details.  Privacy policy

Invalid email address

Thanks for joining us! You'll get a welcome message in a few moments.