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

S

SamDeMan

Registered User.
Local time
Today, 08:38
Joined
Aug 22, 2005
Messages
182
in a Microsfot Article
http://support.microsoft.com/default.aspx?scid=kb;en-us;Q328320
titled: How to create a dynamic crosstab report in Access 2002

I had many errors because the code is written in DAO, so i decided to rewrite this code in ADO instead. it works fine and i get the first record and the total. however, i don't get all the records from the query, can anybody help. (BTW, i don't need the totals of the rows, and may take that out. for now i left them in).

thanks,

sam

copy of the ADO code:

' 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 ReportFooter_Print(Cancel As Integer, PrintCount As Integer)

Dim intX As Integer

' Put column totals in text boxes in report footer.
' Start at column 2 (first text box with crosstab value).
For intX = 2 To intColumnCount
Me("Tot" + Format(intX)) = lngRgColumnTotal(intX)
Next intX

' Put grand total in text box in report footer.
Me("Tot" + Format(intColumnCount + 1)) = lngReportTotal

' Hide unused text boxes in report footer.
For intX = intColumnCount + 2 To conTotalColumns
Me("Tot" + Format(intX)).Visible = False
Next intX

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
 
Trying to bring this back to the top. Can anyone help this individual so that I can also glean some useful info from this thread. I am trying to accomplish much the same. Thanks.
 
Also trying to bring this to the top.

I have an identical problem. I have seen mentioned a solution by setting
Code: 
Me.nextrecord = False
Could someone explain to me where this would go? I have tried Detail_Retreat and other places to no avail. All I end up with is infinite(?) number of duplicate rows.

I have been working on this problem for days now, and I am getting incredibly frustrated!
 
Please? Anyone? Look at the number of views this is getting - so many people need this or similar solution!
 
Hi

I just was did a search on the posts i did on this site and came across this post. i see that you are troubled with this type of report. i would like to help if i am able to. first post your questions. second, i used a combination of code. my report works fine. you can look at the microsoft link i posted or go to Barnes & Nobles and either browse the book that i am about to give you or better yet BUY IT!! it will be the best purchase you made this year. the book is "Access 2002 Desktop Developer's Handbook" written the by Ken Getz. you can buy it as a set or individually. the second book in the set is more about networks and stuff like that. Go to page 663 and you will find your answer.
i would write more about this problem, but i think that this author really did a fine job explaining it.

this is my understanding of this issue:
usually we create reports with a set amount of fields and all of the fields are bound to some field in a table or query. the problem is that you want to violate both assumptions, you want it to be variable amount of fields and you want bound them after you run your query. but we agree that once you run your query (crosstab) at that point you know how many fields you need and you have their names. basically, that is exactly this code. first you set up a report with a lot of unbound fields. the report itself is unbound. (this means that if you look at the data properties of the form it is blank). then you write a code that will run the query and attach them to your unbound fields.

regarding the ADO/DAO the microsoft code is written for DAO, the book has it for ADO.

i will be happy to answer any other issues (if i know the answers).

good luck to you all,

this site rocks,

sam
 
Thanks for coming back Sam,

I well understand the principle (and getting to that point has taught me a lot). I think I even understand how Access prints the rows in the detail section.

I have already purchased two Access books (Access 2003 Bible and Access 2003 VBA - Programmer's Reference). I am reluctant to spend another £30 ontop of the £50 I have already spent.

I just get the feeling that the solution is just out of my reach... I've decided to try exporting the data to excel. I think that this will actually be more useful to the end-users to be frank. I'm just annoyed that I couldn't work out WHY it didn't work!

This is the code as it was when I gave up on it:
Code: 
Option Compare Database
Option Explicit

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

' 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
    Dim intY As String
        
    ' Verify that you are not at end of recordset.
    Do While Not rstReport.EOF
    '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
            
            
        End If
    ' Move to next record in recordset.
    Debug.Print rstReport.Fields(0).Value
    rstReport.MoveNext
            
    'Me.NextRecord = False
    'End If
    Loop

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))
            Debug.Print lngRgColumnTotal(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 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) = rstReport(intX - 1).name
    Next intX
    
    ' Make next available text box Totals heading.
    xstr = "Head" + CStr(intColumnCount + 1)
    Me(xstr) = "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 = "xxDEV_crosstab"
    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 ReportFooter_Print(Cancel As Integer, PrintCount As Integer)

    Dim intX As Integer
    
    ' Put column totals in text boxes in report footer.
    ' Start at column 2 (first text box with crosstab value).
    For intX = 2 To intColumnCount
        Me("Tot" + Format(intX)) = lngRgColumnTotal(intX)
    Next intX
    
    ' Put grand total in text box in report footer.
    Me("Tot" + Format(intColumnCount + 1)) = lngReportTotal
    
    ' Hide unused text boxes in report footer.
    For intX = intColumnCount + 2 To conTotalColumns
        Me("Tot" + Format(intX)).Visible = False
    Next intX

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) 'unneccessary?

    'Initialize variables.
    InitVars

End Sub
 
Last edited:
Hi

i am working long hours here, so i really didn't have the time to test and inspect your whole code. i happen to be working today on the same report, and i remembered that there was something missing in the literture that made my report work. i guess it really depends on how you structure the code. i will paste in here some code that worked for me. i think it is far more simpler than any other code i have seen.
before i do that, i would like to point out, that i didn't notice in your code and it was a problem in my code the following: me.controlsource = "myqueryName" as i mentioned it isn't in any of the lit that i read.

here is the code:
Code: 
Private Sub Report_Open(Cancel As Integer)
  
   Dim intColumnCount As Integer
   Dim intControlCount As Integer
   Dim intX As Integer
   Dim strName As String

   On Error Resume Next
   
   Dim rstReport As ADODB.Recordset
   Dim QueryCmd As ADODB.Command
   Dim Pa As ADODB.Parameter

   Set rstReport = New ADODB.Recordset
   Set QueryCmd = New ADODB.Command
   Set Pa = New ADODB.Parameter
   Set QueryCmd.ActiveConnection = CurrentProject.Connection
   QueryCmd.CommandText = "MyCrosstabQuery"
   QueryCmd.CommandType = adCmdTable
   QueryCmd.Parameters.Refresh
   
   Me.RecordSource = "MyCrosstabQuery"  'this line seems to be the key
   
   For Each Pa In QueryCmd.Parameters
        Pa.Value = Eval(Pa.Name)
   Next Pa

   Set rstReport = QueryCmd.Execute

   intColumnCount = rstReport.Fields.Count
   intControlCount = Me.Detail.Controls.Count

   For intX = intColumnCount To intControlCount
           Me.Controls("Head" & intX).Visible = False
           Me.Controls("Col" & intX).Visible = False
   Next intX

   If intControlCount < intColumnCount Then
        intColumnCount = intControlCount
   End If

   For intX = 1 To intColumnCount
      strName = rstReport.Fields(intX - 1).Name
      Me.Controls("Head" & intX).Caption = strName
      Me.Controls("Col" & intX).ControlSource = strName
   Next intX
   rstReport.Close
   Set rstReport = Nothing
   Set QueryCmd = Nothing
End Sub
 
Thanks Sam, really appreciate that.

It worked, up to a point... as with your first posting I had to fiddle with the Header.Caption to get it to work, however, this time it didn't. I've put this on the back burner now in favour of an export-to-excel, but I may return to this as it will likely be necessary.

I'm using Access 2002, but in Access 2000 file format. Any ideas why it wouldn't work? I tried putting literal strings and all sorts...
 
Sorry to bring this thread to the top again, but did anybody actually resolve the issue relating to the detail section. I have been working on this for quite some time now and thanks to SamDeMan with the code "me.controlsource = "myqueryName"" I can now see the correct amount of lines in my crosstab. However, The rows are being produced without changing the description.

Example:

If I had 3 issues, Timeclocks, Cleaning and Catering they would all display on sepearte rows but saying Timeclocks for each.

Does anyone know a way around this as the report isn't useable in this state.

I have created an Excel output as a temporary solution but I would prefer to have the report constructed in Access

Regards

Jason
 
You can set up the report groupings as if this was a bounded report. you need to type them in (as apposed to selecting them). add the group header and/or footer if you need them.

i did some interesting things with this type of report. including totals of all sorts. the only total i wasn't able to get was a total using sub groupings that exclude the general groupings. for example i have region1, region2 etc.. and in each region i have city1, city2 etc. and then i have in each city facility1, facility2 etc.. and for each facility i have daily_production. i then need the total by city (not by facility or other groupings). i had a hard time doing this for the crosstab report. i tried subReports, but i got an error message that subReports can't be unbounded. so i am stuck.

good luck to you all. hope someone out there will be able to help me out as well.

sam
 
You must log in or register to reply here.

Similar threads

oxicottin
How to stop form from closing
Replies
7
Views
1,279
Pat Hartman
P
A
Solved Adding Items to Combobox, but They aren't showing up
2
Replies
21
Views
788
AngelSpeaks
A
D
Solved Setting a field to null on Dirty
Replies
10
Views
462
dullster
D
Mike Krailo
Solved Need help with before update code logic?
Replies
12
Views
538
Mike Krailo
Mike Krailo
H
Solved Search across multiple fields
Replies
8
Views
788
Harry Paraskeva
H

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom