R
Robert Neville
I want to create a report that includes contact names grouped by
JobTitle ROW HEADERS; as oppose to using column header. The report
would help me consolidate information for placement on as a
sub-report. The following data serves as an example.
Sales Representative: John Smith - Larry Johnson - Nancy Davolio -
Janet Leverling - Margaret Peacock - Suyama Michael - Robert King
Vice President, Sales: Andrew Fuller
Sales Manager: Steven Buchanan - Anne Dodsworth
Inside Sales Coordinator: Laura Callahan
Sales Representatives would be the Job Title label; and the hyphen
would delimiter the Contact Name (FirstName & " " & LastName)
A query in conjunction with VBA code may accomplish my objective. I
have been experimenting with several approaches. You may review the
code at the bottom of this post and the SQL follow.
The SQL statement below works, yet I would appreciate your thoughts on
their efficiency. The SQL executes in 60 second for 3549 records.
SELECT First(TEMP_qryContProj.ProjID) AS ProjID,
First(TEMP_qryContProj.JobTitle) AS JobTitle,
StringList("[ContactName]","[TEMP_qryContProj]","[ProjID] =" &
[ProjID] & "AND [JobTitle]='" & [JobTitle] & "'"," - ") AS
ContactNames
FROM TEMP_qryContProj
GROUP BY TEMP_qryContProj.ProjID,
StringList("[ContactName]","[TEMP_qryContProj]","[ProjID] =" &
[ProjID] & "AND [JobTitle]='" & [JobTitle] & "'"," - ")
ORDER BY First(TEMP_qryContProj.ProjID);
This SQL executes faster, yet returns duplicate for each ProjID and
Jobtitle. The duplicates repeat for each concatenated contact return
by the function.
SELECT TEMP_qryContProj.ProjID AS ProjID, TEMP_qryContProj.JobTitle AS
JobTitle, StringList("[ContactName]","[TEMP_qryContProj]","[ProjID] ="
& [ProjID] & "AND [JobTitle]='" & [JobTitle] & "'"," - ") AS
ContactNames
FROM TEMP_qryContProj
ORDER BY TEMP_qryContProj.ProjID;
Please let me know how I could improve my approach since the query
execute too slow for a report with many sub-reports.
'************ Code Start **********
Public Function StringList(varColumns, varTable, _
Optional strWhere As String, Optional strDelimiter = "
- ")
' StringList("[ContactName]","[TEMP_qryContProj]","[ProjID] =" &
[ProjID] & "AND [JobTitle]='" & [JobTitle] & "'"," - ")
Dim dbs As Database
Dim rst As Recordset
Dim fldLoop As Field
Dim strSQL As String
Dim strLineOut As String
Const cstrProc As String = "StringList"
On Error GoTo StringList_Err
' Return reference to current database.
Set dbs = CurrentDb
If strWhere = "" Then strWhere = "true"
strSQL = "Select " & varColumns & " From " & varTable
strSQL = strSQL & " Where " & strWhere
' Debug.Print strSQL
' Exit Function
Set rst = dbs.OpenRecordset(strSQL)
rst.MoveFirst
Do Until rst.EOF
With rst
For Each fldLoop In .Fields
strLineOut = strLineOut & fldLoop.Value & strDelimiter
Next fldLoop
End With
rst.MoveNext
Loop
StringList = Left(strLineOut, Len(strLineOut) - Len(strDelimiter))
StringList_Exit:
Set rst = Nothing
Set dbs = Nothing
Exit Function
StringList_Err:
Call ErrMsgStd(mcstrMod & "." & cstrProc, Err.Number,
Err.Description, True)
Resume StringList_Exit
End Function
'************ Code End **********
JobTitle ROW HEADERS; as oppose to using column header. The report
would help me consolidate information for placement on as a
sub-report. The following data serves as an example.
Sales Representative: John Smith - Larry Johnson - Nancy Davolio -
Janet Leverling - Margaret Peacock - Suyama Michael - Robert King
Vice President, Sales: Andrew Fuller
Sales Manager: Steven Buchanan - Anne Dodsworth
Inside Sales Coordinator: Laura Callahan
Sales Representatives would be the Job Title label; and the hyphen
would delimiter the Contact Name (FirstName & " " & LastName)
A query in conjunction with VBA code may accomplish my objective. I
have been experimenting with several approaches. You may review the
code at the bottom of this post and the SQL follow.
The SQL statement below works, yet I would appreciate your thoughts on
their efficiency. The SQL executes in 60 second for 3549 records.
SELECT First(TEMP_qryContProj.ProjID) AS ProjID,
First(TEMP_qryContProj.JobTitle) AS JobTitle,
StringList("[ContactName]","[TEMP_qryContProj]","[ProjID] =" &
[ProjID] & "AND [JobTitle]='" & [JobTitle] & "'"," - ") AS
ContactNames
FROM TEMP_qryContProj
GROUP BY TEMP_qryContProj.ProjID,
StringList("[ContactName]","[TEMP_qryContProj]","[ProjID] =" &
[ProjID] & "AND [JobTitle]='" & [JobTitle] & "'"," - ")
ORDER BY First(TEMP_qryContProj.ProjID);
This SQL executes faster, yet returns duplicate for each ProjID and
Jobtitle. The duplicates repeat for each concatenated contact return
by the function.
SELECT TEMP_qryContProj.ProjID AS ProjID, TEMP_qryContProj.JobTitle AS
JobTitle, StringList("[ContactName]","[TEMP_qryContProj]","[ProjID] ="
& [ProjID] & "AND [JobTitle]='" & [JobTitle] & "'"," - ") AS
ContactNames
FROM TEMP_qryContProj
ORDER BY TEMP_qryContProj.ProjID;
Please let me know how I could improve my approach since the query
execute too slow for a report with many sub-reports.
'************ Code Start **********
Public Function StringList(varColumns, varTable, _
Optional strWhere As String, Optional strDelimiter = "
- ")
' StringList("[ContactName]","[TEMP_qryContProj]","[ProjID] =" &
[ProjID] & "AND [JobTitle]='" & [JobTitle] & "'"," - ")
Dim dbs As Database
Dim rst As Recordset
Dim fldLoop As Field
Dim strSQL As String
Dim strLineOut As String
Const cstrProc As String = "StringList"
On Error GoTo StringList_Err
' Return reference to current database.
Set dbs = CurrentDb
If strWhere = "" Then strWhere = "true"
strSQL = "Select " & varColumns & " From " & varTable
strSQL = strSQL & " Where " & strWhere
' Debug.Print strSQL
' Exit Function
Set rst = dbs.OpenRecordset(strSQL)
rst.MoveFirst
Do Until rst.EOF
With rst
For Each fldLoop In .Fields
strLineOut = strLineOut & fldLoop.Value & strDelimiter
Next fldLoop
End With
rst.MoveNext
Loop
StringList = Left(strLineOut, Len(strLineOut) - Len(strDelimiter))
StringList_Exit:
Set rst = Nothing
Set dbs = Nothing
Exit Function
StringList_Err:
Call ErrMsgStd(mcstrMod & "." & cstrProc, Err.Number,
Err.Description, True)
Resume StringList_Exit
End Function
'************ Code End **********