Solved Order pivot columns

[Kayleigh]

Hi,
I have located the following code to order to columns of a crosstab query run dynamically. However for some reason the temp table is only capturing one row instead of all. Have tried various methods to but can't get to the bottom of this issue. Can anyone help here?

Public Sub SortPivotColumns(querynameSource As String, queryname As String, SortName As String, SortColumnNameField As String, SortIndexName As String, NonPivotFieldCount As Integer, ParamArray ParamArr() As Variant)

' This sub goes through several steps to effectively adds an In list that sorts the 'Columns' of a crosstab query in MS Access
' 13 November 2012
' E Easterly
'
' This technique uses several components.
' 1) The original unmodified cross tab query (querynameSource)
' 2) The resulting, columns-have-been-sorted query (query)
' 3) An index table which has two columns, a numeric index used for sorting and the column name
' 4) A table or query that can be joined on the column names of the cross tab query to update the index table
'    The name of the table or query would be 'SortName'
'    The field in 'SortName' that the crosstab query columns are joined against is the 'SortColumnNameField'
'    The field in 'SortName' that has the desired order is the SortIndexName
' 5) A number which specifies the count of non-pivot/row heading columns (NonPivotFieldCount)
' 6) An optional array that contains any parameters needed for the query
'
'
'   USE:
'
'   SortPivotColumns "qryCrosstab_Initial", _
'                 "qryCrosstab_Sorted", _
'                 "tblKeyDescriptions", _
'                 "Descriptions", _
'                 "NumericIndexForSorting", _
'                  1
'
'
'
'
Dim rs As DAO.Recordset
Dim db As Database
Dim fld As DAO.Field
Dim sql As String
Dim ColumnHeading As Variant
Dim qdf As QueryDef
Dim qdfSRC As QueryDef
Dim UpdateIndexSQL As Variant

DoCmd.SetWarnings False 'Turn off warnings

Set db = CurrentDb

Set qdfSRC = db.QueryDefs(querynameSource)
Set qdf = db.QueryDefs(queryname)
qdf.sql = qdfSRC.sql

If Not (IsEmpty(ParamArr)) Then
    Dim i As Integer
    For i = 0 To UBound(ParamArr)
        qdf.Parameters(i) = ParamArr(i)
    Next
End If


' First, get the list of fields from the query

Set rs = qdf.OpenRecordset

' Then, create a temporary indexing table
If Not IsNull(DLookup("Name", "MSysObjects", "Name='ttblSortCrosstabColumns' And Type In (1,4,6)")) Then
    db.Execute "DROP TABLE ttblSortCrosstabColumns"
End If

db.Execute "CREATE TABLE ttblSortCrosstabColumns (FieldIndex INTEGER , ColumnName TEXT(250))"

' And populate it with the current index and column names from queryname
  For Each fld In rs.Fields
    If fld.OrdinalPosition > (NonPivotFieldCount - 1) Then
        DoCmd.RunSQL "Insert into ttblSortCrosstabColumns VALUES(" & fld.OrdinalPosition & ", """ & fld.Name & """)"
    End If
  Next fld
  Set fld = Nothing
  rs.Close
  Set rs = Nothing


' Now, the temporary table is joined with the sort table/query and the indexes are updated
UpdateIndexSQL = ("  UPDATE ttblSortCrosstabColumns " & _
                  "  INNER JOIN " & SortName & " ON ttblSortCrosstabColumns.ColumnName=" & SortName & "." & SortColumnNameField & _
                  "  Set ttblSortCrosstabColumns.FieldIndex = [" & SortIndexName & "]")
                  Debug.Print UpdateIndexSQL
DoCmd.RunSQL (UpdateIndexSQL)


' Then, the column headings are added to a string to prepare the In list
sql = "SELECT ttblSortCrosstabColumns.ColumnName FROM ttblSortCrosstabColumns ORDER BY ttblSortCrosstabColumns.FieldIndex"
Set rs = db.OpenRecordset(sql)
    rs.MoveFirst
    ColumnHeading = "'" & rs.Fields(0).Value & "'"
    rs.MoveNext

    Do While Not rs.EOF
    ColumnHeading = ColumnHeading & ", '" & rs.Fields(0).Value & "'"
    rs.MoveNext
    Loop

rs.Close
Set rs = Nothing
 'db.Execute "DROP TABLE ttblSortCrosstabColumns"

Dim cs As Variant

' Set qdf = db.QueryDefs(queryname)   ' may not need this

' The query is updated with the In list
cs = Left$(qdf.sql, Len(qdf.sql) - 3) & " In(" & ColumnHeading & ");"

qdf.sql = cs

' Take a look at the resulting query sql by uncommenting the below section
Debug.Print cs


DoCmd.SetWarnings True  'Turn warnings back on

End Sub

Code was adapted from https://stackoverflow.com/questions...rosstab-query-when-the-column-data-is-dynamic

Cheers, Krayna

 

[theDBguy]

Easiest way to find out what's happening is to step through the code. Can you post a sample db with test data, so we can step through it?

 

[Kayleigh]

This is the gist of it...

 

[arnelgp]

there is somewhat similar thread here:

Solved - Crosstab Query - Dynamic Column Sorting | Access World Forums (access-programmers.co.uk)

 

[Kayleigh]

Thanks for pointing me in that direction. I don't know why I was taking such a complicated approach when all I had to do was iterate through the query recordset to create the 'IN' statement. It works fine with this code:

'Adding order string to crosstab headings
Set rs1 = db.OpenRecordset("qrySessionsByStaffDays")
strsql = Chr(40)

If Not rs1.BOF And Not rs1.EOF Then
    rs1.MoveFirst
    While (Not rs1.EOF)
        strsql = strsql & Chr(34) & rs1!fldDay & Chr(34) & Chr(44)
        rs1.MoveNext
    Wend
End If
rs1.Close
strsql = Left(strsql, Len(strsql) - 1)
strsql = strsql & Chr(41)

'Crosstab with details of sessions
strSql3 = "TRANSFORM First(qrySessionsAllExtended.cfDetails) AS FirstOfcfDetails " & vbCrLf & _
"SELECT qrySessionsByStaff.Time " & vbCrLf & _
"FROM qrySessionsAllExtended RIGHT JOIN qrySessionsByStaff ON qrySessionsAllExtended.fldSessionDayTimesID = qrySessionsByStaff.fldSessionDayTimesID " & vbCrLf & _
"WHERE (((qrySessionsByStaff.fldStaffID)=" & intX & ")) " & vbCrLf & _
"GROUP BY qrySessionsByStaff.Time, qrySessionsByStaff.fldStaffID, qrySessionsByStaff.jtblSessionDayTimes.fldStart " & vbCrLf & _
"ORDER BY qrySessionsByStaff.jtblSessionDayTimes.fldStart " & vbCrLf & _
"PIVOT qrySessionsByStaff.fldday" & " IN " & strsql & ";"