Complex Concatenation in Access


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:

AW 1706-B

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.

 

1
Private Sub cmdCreateWorkList_Click()
1
 
1
On Error GoTo ErrorHandler
1
 
1
   Dim lngCount As Long
1
   Dim lngStaffID As Long
1
   Dim lst As Access.ListBox
1
   Dim strFilter As String
1
   Dim strPrompt As String
1
   Dim strQuery As String
1
   Dim strRecordSource As String
1
   Dim strSQL As String
1
   Dim strTitle As String
1
   Dim varItem As Variant
1
 
1
<strong><em>   'Create filter string for selected crews</em></strong>
1
   Set lst = Me![lstStaff]

 

1
<strong><em>   'Check that at least one item has been selected</em></strong>
1
   If lst.ItemsSelected.Count = 0 Then
1
      strTitle = "No items selected"
1
      strPrompt = "Please select at least one staff person"
1
      MsgBox prompt:=strPrompt, _
1
         buttons:=vbInformation + vbOKOnly, _
1
         Title:=strTitle
1
      lst.SetFocus
1
      GoTo ErrorHandlerExit
1
   End If
1
 
1
   For Each varItem In lst.ItemsSelected
1
      lngStaffID = Nz(lst.Column(0, varItem))
1
      strFilter = strFilter &amp; "[StaffID] = " &amp; lngStaffID &amp; " Or "

 

1
NextItem:
1
   Next varItem
1
 
1
   If Right(strFilter, 4) = " Or " Then
1
      strFilter = Left(strFilter, Len(strFilter) - 4)
1
   End If
1
 
1
   Debug.Print "Filter string: " &amp; strFilter
1
   strRecordSource = "qryWorkAndStaff"
1
   strQuery = "qryWorkListSelectedStaff"
1
   strSQL = "SELECT * FROM " &amp; strRecordSource &amp; " WHERE " _
1
      &amp; strFilter &amp; ";"
1
   Debug.Print "SQL for " &amp; strQuery &amp; ": " &amp; strSQL
1
   lngCount = CreateAndTestQuery(strQuery, strSQL)
1
   Debug.Print "No. of items found: " &amp; lngCount
1
   If lngCount = 0 Then
1
      strPrompt = "No records found for these staff persons; canceling"
1
      strTitle = "Canceling"
1
      MsgBox strPrompt, vbOKOnly + vbCritical, strTitle
1
      GoTo ErrorHandlerExit
1
   End If
1
 
1
   Call ConcatenateWorkTypes
1
   DoCmd.OpenReport "rptWorkList", View:=acViewPreview
1
 
1
 
1
ErrorHandlerExit:
1
   Exit Sub
1
 
1
ErrorHandler:
1
   MsgBox "Error No: " &amp; Err.Number _
1
      &amp; " in " &amp; Me.ActiveControl.Name &amp; " procedure; " _
1
      &amp; "Description: " &amp; Err.Description
1
   Resume ErrorHandlerExit
1
 
1
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.

1
Public Sub ConcatenateWorkTypes()
1
 
1
On Error GoTo ErrorHandler
1
 
1
   Dim blnNewSet As Boolean
1
   Dim dteCurrentWork As Date
1
   Dim dteWork As Date
1
   Dim lngCount As Long
1
   Dim lngCounter As Long
1
   Dim lngCurrentStaffID As Integer
1
   Dim lngStaffID As Integer
1
   Dim rstSource1 As DAO.Recordset
1
   Dim rstSource2 As DAO.Recordset
1
   Dim rstTarget As DAO.Recordset
1
   Dim rstWorkTypes As DAO.Recordset
1
   Dim rstWorkTypesSorted As DAO.Recordset
1
   Dim strCode As String
1
   Dim strCurrentCode As String
1
   Dim strCurrentWorkType As String
1
   Dim strFilter As String
1
   Dim strQuery As String
1
   Dim strSourceQuery As String
1
   Dim strSQL As String
1
   Dim strStaffName As String
1
   Dim strWorkType As String
1
   Dim strWorkTypes As String
1
 
1
   strSQL = "DELETE * FROM tblWorkSelectedStaff"
1
   CurrentDb.Execute strSQL
1
 
1
   strSourceQuery = "qryWorkListSelectedStaff"
1
   strQuery = "qryWorkTypesPerStaff"
1
   Set rstSource1 = CurrentDb.OpenRecordset(strSourceQuery, dbOpenDynaset)
1
   Set rstTarget = CurrentDb.OpenRecordset("tblWorkSelectedStaff")
1
   Set rstWorkTypes = CurrentDb.OpenRecordset("tblWorkTypes")
1
 
1
   lngStaffID = 0
1
   strCode = ""
1
   dteWork = #12:00:00 AM#
1
 
1
   With rstSource1
1
      Do While Not .EOF
1
         lngCurrentStaffID = ![StaffID]
1
         strCurrentCode = ![Code]
1
         dteCurrentWork = ![WorkDate]
1
         strWorkType = ![WorkType]
1
 
1
<strong><em>         'Check whether this is a new set or not</em></strong>
1
         If lngCurrentStaffID = lngStaffID And strCurrentCode = _
1
            strCode And dteCurrentWork = dteWork Then
1
            blnNewSet = False
1
         Else
1
            blnNewSet = True
1
            lngStaffID = lngCurrentStaffID
1
            strCode = strCurrentCode
1
            dteWork = dteCurrentWork
1
            strWorkType = ![WorkType]
1
            strStaffName = ![StaffName]
1
         End If
1
 
1
         If blnNewSet = True Then
1
            strFilter = "[StaffID] = " &amp; lngStaffID &amp; " And [Code] = " _
1
               &amp; Chr(39) &amp; strCode &amp; Chr(39) &amp; " And [WorkDate] = " _
1
               &amp; Chr(35) &amp; dteWork &amp; Chr(35)
1
            strSQL = "SELECT * FROM " &amp; strSourceQuery &amp; " WHERE " _
1
               &amp; strFilter &amp; ";"
1
            Debug.Print "SQL for " &amp; strQuery &amp; ": " &amp; strSQL
1
            lngCount = CreateAndTestQuery(strQuery, strSQL)
1
            Debug.Print "No. of items found for set: " &amp; lngCount
1
            Set rstSource2 = CurrentDb.OpenRecordset(strQuery)
1
 
1
<strong><em>            'Save Work Types for this set of records to temp table</em></strong>
1
            strSQL = "DELETE * FROM tblWorkTypes"
1
            CurrentDb.Execute strSQL
1
 
1
            Do While Not rstSource2.EOF
1
               strWorkType = rstSource2![WorkType]
1
               Debug.Print "Current Work Type: " &amp; strWorkType
1
               rstWorkTypes.AddNew
1
               rstWorkTypes![WorkType] = strWorkType
1
               rstWorkTypes.Update
1
               rstSource2.MoveNext
1
            Loop
1
 
1
<strong><em>            'Concatenate work types for this set of records</em></strong>
1
            Set rstWorkTypesSorted = _
1
               CurrentDb.OpenRecordset("qryWorkTypesSorted")
1
            strWorkTypes = ""
1
 
1
            With rstWorkTypesSorted
1
               Do While Not .EOF
1
                  strWorkType = ![WorkType]
1
                  strWorkTypes = strWorkTypes &amp; strWorkType &amp; ", "
1
                  .MoveNext
1
               Loop
1
 
1
               .Close
1
            End With
1
 
1
            strWorkTypes = Left(strWorkTypes, Len(strWorkTypes) - 2)
1
            Debug.Print "Concatenated Work Types: " &amp; strWorkTypes
1
 
1
            With rstTarget
1
               .AddNew
1
               ![StaffID] = lngStaffID
1
               ![StaffName] = strStaffName
1
               ![Code] = strCode
1
               ![WorkDate] = dteWork
1
               ![WorkTypes] = strWorkTypes
1
               .Update
1
             End With
1
         End If
1
 
1
         .MoveNext
1
      Loop
1
   End With
1
 
1
ErrorHandlerExit:
1
   Exit Sub
1
 
1
ErrorHandler:
1
   MsgBox "Error No: " &amp; Err.Number _
1
      &amp; " in ConcatenateWorkTypes procedure; " _
1
      &amp; "Description: " &amp; Err.Description
1
   Resume ErrorHandlerExit
1
 
1
End Sub

The report is shown below:AW 1706-C

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.

Document Name Document Type Place in
Complex Concatenation (AA 241).accdb Access 2007-2010 database (can also be used in higher versions of Access) Wherever you want

Want More?

Office Watch has the latest news and tips about Microsoft Office.  Delivered once a week.