Cross Tab problem

[hinchi1]

I have this Cross tab query which works fine if I have the Course List set as Column Heading and the Names of the people attending the courses set as Row Headings. The issue this way is the list of courses is much greater than the number of people, so when i export the data to Excel, the sheet looks a bit out of skew. However, if I change this around to have the Course List as the Row Heading and the Names as Column Headings, the course list shows duplicate courses(which i don't want). As anyone got any ideas how to remove the duplicates? Thanks in advance. I have also added the SQL code generated from the Cross Tab Query:

TRANSFORM Last(qCoursesAttendedReport.[Course Check]) AS [LastOfCourse Check]
SELECT qCoursesAttendedReport.EventName AS [Courses Attended]


FROM qCoursesAttendedReport
GROUP BY qCoursesAttendedReport.EventName, qCoursesAttendedReport.Supervisor_FK, qCoursesAttendedReport.LineManager_FK
ORDER BY [FirstName] & " " & [LastName]
PIVOT [FirstName] & " " & [LastName];

[CJ_London]

remove the two fields you are not displaying (Supervisor_FK and LineManager_FK)

[hinchi1]

remove the two fields you are not displaying (Supervisor_FK and LineManager_FK)

Thanks for this. It worked a treat, thanks. Just need to sort out the cell wrapping when I export to Excel.

[CJ_London]

for that you need some code to autosize the columns in Excel.

Pick out from this - note how it populates the spreadsheet - an alternative to using transferspreadsheet since you would otherwise need to open the excel file to format it anyway. This has been taken from one of my export functions and I've removed parts not relevant to your requirement but it should compile OK. You may not want all the steps, if you don't then just comment them out

'call as exportToExcel "myXtab" or whatever your query is called

Function exportToExcel(qName as string)
Dim xl As Object 'excel
Dim wb As Object 'workbook
Dim ws As Object 'worksheet

Dim db As DAO.Database
Dim rs As DAO.Recordset

Dim c As Integer 'column iterator

Set xl = CreateObject("Excel.Application")
xl.Visible = True 'hide when code working as required
Set wb = xl.Workbooks.Add

Set ws = wb.worksheets(1)

Set db=currentdb
set rs=db.openrecordset(qName)



    With ws
        
            .Select
            
            '1. prevent wrapping and set font size
            .range(.columns(1), .columns(rs.Fields.Count - 1)).wraptext = False
            .cells.Font.Size = 9
            
            '2. populate header row
            For c = 0 To rs.Fields.Count - 1
            
                ws.cells(1, c + 1).Value = rs.Fields(c).Name
                
            Next c
            
            '3. populate data - header on top row
            .range("A2").CopyFromRecordset rs


            '4. set filter on header row
            .range(.cells(1, 1), .cells(.UsedRange.Rows.Count, rs.Fields.Count - 1)).AutoFilter 'row then column
            
            '5. set back colour on header row
            With .range(.cells(1, 1), .cells(1, rs.Fields.Count - 1)).interior


                .Pattern = 1 'xlSolid
                .ThemeColor = 3 'xlThemeColorDark2
                .TintAndShade = -0.249977111117893
                .PatternTintAndShade = 0
                
            End With '.range

            '7. format columns
            For c = 0 To rs.Fields.Count - 1
            
                Select Case rs.Fields(c).Type
                    
                    Case dbCurrency, dbDouble
                        .range(.columns(c + 1), .columns(c + 1)).NumberFormat = "#,##0.00"
                    
                    Case dbDate
                        .range(.columns(c + 1), .columns(c + 1)).NumberFormat = "m/d/yyyy"
                
                End Select
                
                .range(.columns(1), .columns(rs.Fields.Count)).EntireColumn.AutoFit 'make this the last format instruction
           
            Next c

       end with 'ws

      '9. freeze top row      
       With xl.ActiveWindow
            
           .SplitColumn = 0
           .SplitRow = 1
           .FreezePanes = True
            
      End With 'xl.ActiveWindow

      'change path/file name to suit
      wb.saveas fileName:= _
            CurrentProject.Path & "\Reports\" & qName & ".xlsx", FileFormat:=51, CreateBackup:=False 'xlOpenXMLWorkbook=51

    '12. close everything
    Set ws = Nothing
    wb.Close
    Set wb = Nothing
    xl.Quit
    Set xl = Nothing
    Set rs= Nothing
    Set db= Nothing

End Function

[hinchi1]

Thank you. Will have a look at this in the morning.