dynamic crosstab report - updated to ADO, works, but needs tuning,

[SAm]

in an article on the msdn Microsfot website:
http://support.microsoft.com/defaul...b;en-us;Q328320
titled: How to create a dynamic crosstab report in Access 2002

the code there is written in dao, and since I had many errors, i decided to
rewrite in ADO instead. my code is not complete yet, but it works fine for
the first record. however, i don't get all the records from the query, can
anybody help me get all the records. (BTW, i don't need the totals for the
rows, and i may take that out. for now i left them in).

thanks,

sam

copy of the ADO code - dynamic crosstab report:

' Constant for maximum number of columns crosstab query would
' create plus 1 for a Totals column.
Const conTotalColumns = 15

' Variables for Database object and Recordset.
Dim dbsReport As ADODB.Connection
Dim rstReport As ADODB.Recordset

' Variables for number of columns and row and report totals.
Dim intColumnCount As Integer
Dim lngRgColumnTotal(1 To conTotalColumns) As Long
Dim lngReportTotal As Long

Private Sub InitVars()

Dim intX As Integer

' Initialize lngReportTotal variable.
lngReportTotal = 0

' Initialize array that stores column totals.
For intX = 1 To conTotalColumns
lngRgColumnTotal(intX) = 0
Next intX

End Sub

Private Function xtabCnulls(varX As Variant)

' Test if a value is null.
If IsNull(varX) Then
' If varX is null, set varX to 0.
xtabCnulls = 0
Else
' Otherwise, return varX.
xtabCnulls = varX
End If

End Function

Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
' Put values in text boxes and hide unused text boxes.

Dim intX As Integer
Dim xstr As String
' Verify that you are not at end of recordset.
If Not rstReport.EOF Then
' If FormatCount is 1, put values from recordset into text boxes
' in "Detail" section.
If Me.FormatCount = 1 Then

For intX = 1 To intColumnCount
' Convert Null values to 0.
xstr = "Col" + CStr(intX)
Me(xstr) = xtabCnulls(rstReport(intX - 1))
Next intX

' Hide unused text boxes in the "Detail" section.
For intX = intColumnCount + 2 To conTotalColumns
xstr = "Col" + CStr(intX)
Me(xstr).Visible = False
Next intX

' Move to next record in recordset.
rstReport.MoveNext
End If
End If

End Sub


Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)

Dim intX As Integer
Dim lngRowTotal As Long

' If PrintCount is 1, initialize rowTotal variable.
' Add to column totals.
If Me.PrintCount = 1 Then
lngRowTotal = 0

For intX = 2 To intColumnCount
' Starting at column 2 (first text box with crosstab value),
' compute total for current row in the "Detail" section.
lngRowTotal = lngRowTotal + Me("Col" + Format(intX))

' Add crosstab value to total for current column.
lngRgColumnTotal(intX) = lngRgColumnTotal(intX) + Me("Col" + Format(intX))
Next intX

' Put row total in text box in the "Detail" section.
Me("Col" + Format(intColumnCount + 1)) = lngRowTotal
' Add row total for current row to grand total.
lngReportTotal = lngReportTotal + lngRowTotal
End If
End Sub


Private Sub Detail_Retreat()

' Always back up to previous record when "Detail" section retreats.
rstReport.MovePrevious

End Sub

Private Sub PageHeaderSection_Format(Cancel As Integer, FormatCount As
Integer)

Dim intX As Integer
Dim xstr As String

' Put column headings into text boxes in page header.
For intX = 1 To intColumnCount
xstr = "Head" + CStr(intX)
Me(xstr).Caption = rstReport(intX - 1).Name
Next intX

' Make next available text box Totals heading.
xstr = "Head" + CStr(intColumnCount + 1)
Me(xstr).Caption = "Totals"

' Hide unused text boxes in page header.
For intX = (intColumnCount + 2) To conTotalColumns
Me("Head" + Format(intX)).Visible = False
Next intX

End Sub


Private Sub Report_Close()

On Error Resume Next

' Close recordset.
rstReport.Close

End Sub


Private Sub Report_NoData(Cancel As Integer)

MsgBox "No records match the criteria you entered.", vbExclamation, "No
Records Found"
rstReport.Close
Cancel = True

End Sub

Private Sub Report_Open(Cancel As Integer)

Dim QueryCmd As ADODB.Command
Dim Pa As ADODB.Parameter
Dim frm As Form
Dim intX As Integer

Set QueryCmd = New ADODB.Command
Set QueryCmd.ActiveConnection = CurrentProject.Connection

QueryCmd.CommandText = "UltiproStep4PPD"
QueryCmd.CommandType = adCmdTable
QueryCmd.Parameters.Refresh

For Each Pa In QueryCmd.Parameters
Pa.Value = Eval(Pa.Name)
Next Pa

' Open Recordset object.
Set rstReport = QueryCmd.Execute
' Set a variable to hold number of columns in crosstab query.
intColumnCount = rstReport.Fields.Count

End Sub

Private Sub ReportHeader_Format(Cancel As Integer, FormatCount As Integer)

' Move to first record in recordset at the beginning of the report
' or when the report is restarted. (A report is restarted when
' you print a report from Print Preview window, or when you return
' to a previous page while previewing.)
rstReport.Move (0)

'Initialize variables.
InitVars

End Sub