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"
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.
| 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 |
