Dynamate report creation....help

D

Danka

I have the following code to generate an Access report based on an Acsess
query. It depends on the number of columns (up to max. 31 that is the max
number of column headers I can assign to the letter size paper in landscape
mode) in the query and it will construct the report for it. For wharever
reason the report takes very long to generate and tahe forever to send to
the printer...last time I waited for over 1.5 hour befoer I killed the
proceess. Please can anyone point me out what is wrong with my coding. It
seems to me the "Detail1_Format" is the source of the delay/problem. For a
small recordset (20 rows and 25 columns) I managed to open the report and
send it to the printer in about 5 minutes.....however it took very long last
time with 26 columns and 200 rows in the recordset before I killed the print
job. Thanks.

Option Compare Database
Option Explicit

'Constant for maximum number of columns Outcome Measure query would create
plus 1 for a Totals column.
Const TOTCOLS = 31

'Variables for database object and recordset.
Dim RptDB As Database
Dim RptRS As Recordset

' Variables for number of columns and row and report totals.
Dim IColCnt As Integer
Dim RgColTot(1 To TOTCOLS) As Long
Dim RptTotal As Long

Private Sub Detail1_Format(Cancel As Integer, FormatCount As Integer)
'Place values in text boxes and hide unused text boxes.
Dim i As Integer
Dim strField As String

'Verify that not at end of recordset.
If Not RptRS.EOF Then
'If FormatCount is 1, place values from recordsSet into text boxes
in detail section.
If Me.FormatCount = 1 Then
For i = 1 To IColCnt
'Convert null values to 0.
'Me("Col" + Format$(i)) = xtabCnulls(RptRS(i - 1))
Me("Col" + Format$(i)) = Nz(RptRS(i - 1), 0)
If i >= 3 Then
strField = "F" & i - 2
Me("Tail" + Format$(i)) = DCount(strField, "Scantron",
"Status= 'Valid'")
End If
Next i
'Hide unused text boxes in detail section.
For i = IColCnt + 2 To TOTCOLS
Me("Col" + Format$(i)).Visible = False
Next i
' Move to next record in recordset.
RptRS.MoveNext
End If
End If

End Sub


Private Sub Detail1_Print(Cancel As Integer, PrintCount As Integer)
Const WHITE = 16777215
Const GREY = 13092807

If (Me![LineNum] Mod 2) = 0 Then
Me![BackGround].BackColor = GREY
Else
Me![BackGround].BackColor = WHITE
End If

End Sub

Private Sub Detail1_Retreat()

' Always back up to previous record when detail section retreats.
RptRS.MovePrevious

End Sub

Private Sub InitVars()

Dim i As Integer

' Initialize RptTotal variable.
RptTotal = 0

' Initialize array that stores column totals.
For i = 1 To TOTCOLS
RgColTot(i) = 0
Next i

End Sub


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

Dim i As Integer

' Put column headings into text boxes in page header.
For i = 1 To IColCnt
Me("Head" + Format$(i)) = RptRS(i - 1).Name
Next i

' Hide unused text boxes in page header.
For i = (IColCnt + 2) To TOTCOLS
Me("Head" + Format$(i)).Visible = False
Next i
End Sub

Private Sub Report_Open(Cancel As Integer)
'DoCmd.Maximize
' Create underlying recordset for report using criteria entered in
' Outcome Measure form.
'
Dim i As Integer
Dim MyQuery As querydef


' Set database variable to current database.
Set RptDB = DBEngine.Workspaces(0).Databases(0)

' Open QueryDef.
Set MyQuery = RptDB.QueryDefs("qryValidCandidateTotalVote")

' Open Recordset.
Set RptRS = MyQuery.OpenRecordset()

' If no records match criteria, display message,
' close recordset, and cancel Open event.
If RptRS.RecordCount = 0 Then
MsgBox "No records match the criteria you entered.", 48, "No Records
Found"
RptRS.Close
Cancel = True
Exit Sub
End If

' Set a variable to hold number of columns in crosstab query.
IColCnt = RptRS.Fields.Count

End Sub

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

' Move to first record in recordset at beginning of report
' or when 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.)
RptRS.MoveFirst

'Initialize variables.
InitVars

End Sub
 
D

Duane Hookom

"up to max. 31"... are these for days of the month? Is there a reason why you
are using a solution like this? There are possibly more efficient crosstab
reports.

Can you describe your crosstab query and data?

--
Duane Hookom
Microsoft Access MVP


Danka said:
I have the following code to generate an Access report based on an Acsess
query. It depends on the number of columns (up to max. 31 that is the max
number of column headers I can assign to the letter size paper in landscape
mode) in the query and it will construct the report for it. For wharever
reason the report takes very long to generate and tahe forever to send to
the printer...last time I waited for over 1.5 hour befoer I killed the
proceess. Please can anyone point me out what is wrong with my coding. It
seems to me the "Detail1_Format" is the source of the delay/problem. For a
small recordset (20 rows and 25 columns) I managed to open the report and
send it to the printer in about 5 minutes.....however it took very long last
time with 26 columns and 200 rows in the recordset before I killed the print
job. Thanks.

Option Compare Database
Option Explicit

'Constant for maximum number of columns Outcome Measure query would create
plus 1 for a Totals column.
Const TOTCOLS = 31

'Variables for database object and recordset.
Dim RptDB As Database
Dim RptRS As Recordset

' Variables for number of columns and row and report totals.
Dim IColCnt As Integer
Dim RgColTot(1 To TOTCOLS) As Long
Dim RptTotal As Long

Private Sub Detail1_Format(Cancel As Integer, FormatCount As Integer)
'Place values in text boxes and hide unused text boxes.
Dim i As Integer
Dim strField As String

'Verify that not at end of recordset.
If Not RptRS.EOF Then
'If FormatCount is 1, place values from recordsSet into text boxes
in detail section.
If Me.FormatCount = 1 Then
For i = 1 To IColCnt
'Convert null values to 0.
'Me("Col" + Format$(i)) = xtabCnulls(RptRS(i - 1))
Me("Col" + Format$(i)) = Nz(RptRS(i - 1), 0)
If i >= 3 Then
strField = "F" & i - 2
Me("Tail" + Format$(i)) = DCount(strField, "Scantron",
"Status= 'Valid'")
End If
Next i
'Hide unused text boxes in detail section.
For i = IColCnt + 2 To TOTCOLS
Me("Col" + Format$(i)).Visible = False
Next i
' Move to next record in recordset.
RptRS.MoveNext
End If
End If

End Sub


Private Sub Detail1_Print(Cancel As Integer, PrintCount As Integer)
Const WHITE = 16777215
Const GREY = 13092807

If (Me![LineNum] Mod 2) = 0 Then
Me![BackGround].BackColor = GREY
Else
Me![BackGround].BackColor = WHITE
End If

End Sub

Private Sub Detail1_Retreat()

' Always back up to previous record when detail section retreats.
RptRS.MovePrevious

End Sub

Private Sub InitVars()

Dim i As Integer

' Initialize RptTotal variable.
RptTotal = 0

' Initialize array that stores column totals.
For i = 1 To TOTCOLS
RgColTot(i) = 0
Next i

End Sub


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

Dim i As Integer

' Put column headings into text boxes in page header.
For i = 1 To IColCnt
Me("Head" + Format$(i)) = RptRS(i - 1).Name
Next i

' Hide unused text boxes in page header.
For i = (IColCnt + 2) To TOTCOLS
Me("Head" + Format$(i)).Visible = False
Next i
End Sub

Private Sub Report_Open(Cancel As Integer)
'DoCmd.Maximize
' Create underlying recordset for report using criteria entered in
' Outcome Measure form.
'
Dim i As Integer
Dim MyQuery As querydef


' Set database variable to current database.
Set RptDB = DBEngine.Workspaces(0).Databases(0)

' Open QueryDef.
Set MyQuery = RptDB.QueryDefs("qryValidCandidateTotalVote")

' Open Recordset.
Set RptRS = MyQuery.OpenRecordset()

' If no records match criteria, display message,
' close recordset, and cancel Open event.
If RptRS.RecordCount = 0 Then
MsgBox "No records match the criteria you entered.", 48, "No Records
Found"
RptRS.Close
Cancel = True
Exit Sub
End If

' Set a variable to hold number of columns in crosstab query.
IColCnt = RptRS.Fields.Count

End Sub

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

' Move to first record in recordset at beginning of report
' or when 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.)
RptRS.MoveFirst

'Initialize variables.
InitVars

End Sub
Click to expand...
 
P

Paul

The Access query is dynamate created....

'Adds a stored query to the database
Sub ValidCandidateTotalVoteQuery()
Dim db As DAO.Database
Dim strSql1 As String
Dim strSql2 As String
Dim strSql3 As String
Dim strSql4 As String
Dim strCandidate As String
Dim i As Integer

strSql1 = "SELECT Method, CLng([Branch]) AS Branch_Number"
For i = 1 To Forms!frmBatchImport!Candidate
strCandidate = "[" & DLookup("Candidate", "Candidate", "FieldName=
'" & "F" & i & "'") & "]"
strSql2 = ", CLng(Count(F" & i & ")) AS " & strCandidate
strSql3 = strSql3 + strSql2
'Debug.Print strSql3
Next i
strSql4 = strSql1 & strSql3 & " FROM Scantron WHERE Status = ""Valid""
GROUP BY Branch, Method ORDER BY Method, CLng([Branch]);"
'Debug.Print strSql4
Set db = CurrentDb
With CurrentDb
On Error Resume Next
db.QueryDefs.Delete "qryValidCandidateTotalVote"
Select Case err.Number
Case 0, 3265
' deleted, or didn't exist -- ignore
Case Else
' unexpected error
MsgBox err.Description, vbExclamation, "Error " & err.Number
On Error GoTo 0 ' or your error-handler
Exit Sub
End Select

' Restore normal error-handling.
On Error GoTo 0 ' or your error-handler

db.CreateQueryDef "qryValidCandidateTotalVote", strSql4
End With

Set db = Nothing
End Sub


Here is the actual created Access query...

SELECT Scantron.Method, CLng([Branch]) AS Branch_Number, CLng(Count(F1)) AS
John, CLng(Count(F2)) AS Larry, CLng(Count(F3)) AS Tom, CLng(Count(F4)) AS
Mary, CLng(Count(F5)) AS Susan, CLng(Count(F6)) AS David, CLng(Count(F7)) AS
Paul, CLng(Count(F8)) AS Daniel, CLng(Count(F9)) AS Tommy, CLng(Count(F10))
AS George
FROM Scantron
WHERE (((Scantron.Status)="Valid"))
GROUP BY Scantron.Method, Scantron.Branch
ORDER BY Scantron.Method, CLng([Branch]);

Duane Hookom said:
"up to max. 31"... are these for days of the month? Is there a reason why
you
are using a solution like this? There are possibly more efficient crosstab
reports.

Can you describe your crosstab query and data?

--
Duane Hookom
Microsoft Access MVP


Danka said:
I have the following code to generate an Access report based on an Acsess
query. It depends on the number of columns (up to max. 31 that is the max
number of column headers I can assign to the letter size paper in
landscape
mode) in the query and it will construct the report for it. For wharever
reason the report takes very long to generate and tahe forever to send to
the printer...last time I waited for over 1.5 hour befoer I killed the
proceess. Please can anyone point me out what is wrong with my coding. It
seems to me the "Detail1_Format" is the source of the delay/problem. For
a
small recordset (20 rows and 25 columns) I managed to open the report and
send it to the printer in about 5 minutes.....however it took very long
last
time with 26 columns and 200 rows in the recordset before I killed the
print
job. Thanks.

Option Compare Database
Option Explicit

'Constant for maximum number of columns Outcome Measure query would
create
plus 1 for a Totals column.
Const TOTCOLS = 31

'Variables for database object and recordset.
Dim RptDB As Database
Dim RptRS As Recordset

' Variables for number of columns and row and report totals.
Dim IColCnt As Integer
Dim RgColTot(1 To TOTCOLS) As Long
Dim RptTotal As Long

Private Sub Detail1_Format(Cancel As Integer, FormatCount As Integer)
'Place values in text boxes and hide unused text boxes.
Dim i As Integer
Dim strField As String

'Verify that not at end of recordset.
If Not RptRS.EOF Then
'If FormatCount is 1, place values from recordsSet into text
boxes
in detail section.
If Me.FormatCount = 1 Then
For i = 1 To IColCnt
'Convert null values to 0.
'Me("Col" + Format$(i)) = xtabCnulls(RptRS(i - 1))
Me("Col" + Format$(i)) = Nz(RptRS(i - 1), 0)
If i >= 3 Then
strField = "F" & i - 2
Me("Tail" + Format$(i)) = DCount(strField,
"Scantron",
"Status= 'Valid'")
End If
Next i
'Hide unused text boxes in detail section.
For i = IColCnt + 2 To TOTCOLS
Me("Col" + Format$(i)).Visible = False
Next i
' Move to next record in recordset.
RptRS.MoveNext
End If
End If

End Sub


Private Sub Detail1_Print(Cancel As Integer, PrintCount As Integer)
Const WHITE = 16777215
Const GREY = 13092807

If (Me![LineNum] Mod 2) = 0 Then
Me![BackGround].BackColor = GREY
Else
Me![BackGround].BackColor = WHITE
End If

End Sub

Private Sub Detail1_Retreat()

' Always back up to previous record when detail section retreats.
RptRS.MovePrevious

End Sub

Private Sub InitVars()

Dim i As Integer

' Initialize RptTotal variable.
RptTotal = 0

' Initialize array that stores column totals.
For i = 1 To TOTCOLS
RgColTot(i) = 0
Next i

End Sub


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

Dim i As Integer

' Put column headings into text boxes in page header.
For i = 1 To IColCnt
Me("Head" + Format$(i)) = RptRS(i - 1).Name
Next i

' Hide unused text boxes in page header.
For i = (IColCnt + 2) To TOTCOLS
Me("Head" + Format$(i)).Visible = False
Next i
End Sub

Private Sub Report_Open(Cancel As Integer)
'DoCmd.Maximize
' Create underlying recordset for report using criteria entered in
' Outcome Measure form.
'
Dim i As Integer
Dim MyQuery As querydef


' Set database variable to current database.
Set RptDB = DBEngine.Workspaces(0).Databases(0)

' Open QueryDef.
Set MyQuery = RptDB.QueryDefs("qryValidCandidateTotalVote")

' Open Recordset.
Set RptRS = MyQuery.OpenRecordset()

' If no records match criteria, display message,
' close recordset, and cancel Open event.
If RptRS.RecordCount = 0 Then
MsgBox "No records match the criteria you entered.", 48, "No
Records
Found"
RptRS.Close
Cancel = True
Exit Sub
End If

' Set a variable to hold number of columns in crosstab query.
IColCnt = RptRS.Fields.Count

End Sub

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

' Move to first record in recordset at beginning of report
' or when 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.)
RptRS.MoveFirst

'Initialize variables.
InitVars

End Sub
Click to expand...
Click to expand...
 
D

Duane Hookom

I'm not sure about your original table structure but there are some sample
crosstab reports at
http://www.rogersaccesslibrary.com/OtherLibraries.asp#Hookom,Duane.

--
Duane Hookom
Microsoft Access MVP


Paul said:
The Access query is dynamate created....

'Adds a stored query to the database
Sub ValidCandidateTotalVoteQuery()
Dim db As DAO.Database
Dim strSql1 As String
Dim strSql2 As String
Dim strSql3 As String
Dim strSql4 As String
Dim strCandidate As String
Dim i As Integer

strSql1 = "SELECT Method, CLng([Branch]) AS Branch_Number"
For i = 1 To Forms!frmBatchImport!Candidate
strCandidate = "[" & DLookup("Candidate", "Candidate", "FieldName=
'" & "F" & i & "'") & "]"
strSql2 = ", CLng(Count(F" & i & ")) AS " & strCandidate
strSql3 = strSql3 + strSql2
'Debug.Print strSql3
Next i
strSql4 = strSql1 & strSql3 & " FROM Scantron WHERE Status = ""Valid""
GROUP BY Branch, Method ORDER BY Method, CLng([Branch]);"
'Debug.Print strSql4
Set db = CurrentDb
With CurrentDb
On Error Resume Next
db.QueryDefs.Delete "qryValidCandidateTotalVote"
Select Case err.Number
Case 0, 3265
' deleted, or didn't exist -- ignore
Case Else
' unexpected error
MsgBox err.Description, vbExclamation, "Error " & err.Number
On Error GoTo 0 ' or your error-handler
Exit Sub
End Select

' Restore normal error-handling.
On Error GoTo 0 ' or your error-handler

db.CreateQueryDef "qryValidCandidateTotalVote", strSql4
End With

Set db = Nothing
End Sub


Here is the actual created Access query...

SELECT Scantron.Method, CLng([Branch]) AS Branch_Number, CLng(Count(F1)) AS
John, CLng(Count(F2)) AS Larry, CLng(Count(F3)) AS Tom, CLng(Count(F4)) AS
Mary, CLng(Count(F5)) AS Susan, CLng(Count(F6)) AS David, CLng(Count(F7)) AS
Paul, CLng(Count(F8)) AS Daniel, CLng(Count(F9)) AS Tommy, CLng(Count(F10))
AS George
FROM Scantron
WHERE (((Scantron.Status)="Valid"))
GROUP BY Scantron.Method, Scantron.Branch
ORDER BY Scantron.Method, CLng([Branch]);

Duane Hookom said:
"up to max. 31"... are these for days of the month? Is there a reason why
you
are using a solution like this? There are possibly more efficient crosstab
reports.

Can you describe your crosstab query and data?

--
Duane Hookom
Microsoft Access MVP


Danka said:
I have the following code to generate an Access report based on an Acsess
query. It depends on the number of columns (up to max. 31 that is the max
number of column headers I can assign to the letter size paper in
landscape
mode) in the query and it will construct the report for it. For wharever
reason the report takes very long to generate and tahe forever to send to
the printer...last time I waited for over 1.5 hour befoer I killed the
proceess. Please can anyone point me out what is wrong with my coding. It
seems to me the "Detail1_Format" is the source of the delay/problem. For
a
small recordset (20 rows and 25 columns) I managed to open the report and
send it to the printer in about 5 minutes.....however it took very long
last
time with 26 columns and 200 rows in the recordset before I killed the
print
job. Thanks.

Option Compare Database
Option Explicit

'Constant for maximum number of columns Outcome Measure query would
create
plus 1 for a Totals column.
Const TOTCOLS = 31

'Variables for database object and recordset.
Dim RptDB As Database
Dim RptRS As Recordset

' Variables for number of columns and row and report totals.
Dim IColCnt As Integer
Dim RgColTot(1 To TOTCOLS) As Long
Dim RptTotal As Long

Private Sub Detail1_Format(Cancel As Integer, FormatCount As Integer)
'Place values in text boxes and hide unused text boxes.
Dim i As Integer
Dim strField As String

'Verify that not at end of recordset.
If Not RptRS.EOF Then
'If FormatCount is 1, place values from recordsSet into text
boxes
in detail section.
If Me.FormatCount = 1 Then
For i = 1 To IColCnt
'Convert null values to 0.
'Me("Col" + Format$(i)) = xtabCnulls(RptRS(i - 1))
Me("Col" + Format$(i)) = Nz(RptRS(i - 1), 0)
If i >= 3 Then
strField = "F" & i - 2
Me("Tail" + Format$(i)) = DCount(strField,
"Scantron",
"Status= 'Valid'")
End If
Next i
'Hide unused text boxes in detail section.
For i = IColCnt + 2 To TOTCOLS
Me("Col" + Format$(i)).Visible = False
Next i
' Move to next record in recordset.
RptRS.MoveNext
End If
End If

End Sub


Private Sub Detail1_Print(Cancel As Integer, PrintCount As Integer)
Const WHITE = 16777215
Const GREY = 13092807

If (Me![LineNum] Mod 2) = 0 Then
Me![BackGround].BackColor = GREY
Else
Me![BackGround].BackColor = WHITE
End If

End Sub

Private Sub Detail1_Retreat()

' Always back up to previous record when detail section retreats.
RptRS.MovePrevious

End Sub

Private Sub InitVars()

Dim i As Integer

' Initialize RptTotal variable.
RptTotal = 0

' Initialize array that stores column totals.
For i = 1 To TOTCOLS
RgColTot(i) = 0
Next i

End Sub


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

Dim i As Integer

' Put column headings into text boxes in page header.
For i = 1 To IColCnt
Me("Head" + Format$(i)) = RptRS(i - 1).Name
Next i

' Hide unused text boxes in page header.
For i = (IColCnt + 2) To TOTCOLS
Me("Head" + Format$(i)).Visible = False
Next i
End Sub

Private Sub Report_Open(Cancel As Integer)
'DoCmd.Maximize
' Create underlying recordset for report using criteria entered in
' Outcome Measure form.
'
Dim i As Integer
Dim MyQuery As querydef


' Set database variable to current database.
Set RptDB = DBEngine.Workspaces(0).Databases(0)

' Open QueryDef.
Set MyQuery = RptDB.QueryDefs("qryValidCandidateTotalVote")

' Open Recordset.
Set RptRS = MyQuery.OpenRecordset()

' If no records match criteria, display message,
' close recordset, and cancel Open event.
If RptRS.RecordCount = 0 Then
MsgBox "No records match the criteria you entered.", 48, "No
Records
Found"
RptRS.Close
Cancel = True
Exit Sub
End If

' Set a variable to hold number of columns in crosstab query.
IColCnt = RptRS.Fields.Count

End Sub

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

' Move to first record in recordset at beginning of report
' or when 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.)
RptRS.MoveFirst

'Initialize variables.
InitVars

End Sub
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA Coding Help for Beginner 0
Help needed! Extracting Heading 3 and Contents from a Word Doc to Excel 0
AddPicturesToShapes 0
Word macro that can call cells out of Excel for a find and replace 0
VBA Export to PDF 0
Making a macro only work on certain files 2
Row and Column Averages in Dynamic Crosstab Report? 3
VBA-Table Word 2019 - Move a selected text, from a cell to the adjacent cell to its right, by pressing the ENTER key 0

Top