Hello,
when I preview my report, all calculations on all pages are correct for the current rep name shown. However, when I click on the print button, the second page calcs now appear for the first rep name, and the second rep's calcs appear on each remaining page (there are 14 reps in all). the client's data base consists of 6 tables; the two largest (500,000 + records) being where the bulk of the data comes from. The relationships are not direct between the tables so I had to create an additional link table to get the correct data. I use several queries in the report and receive no errors while processing. It's just when I print that the report is not correct. As stated above, ; preview mode is fine. Any thoughts?
below is a sample of the vba code used. I use a form to get the report date range and call the report from it. I eliminated some of the calcs as they're the same as for the remaining code, just outside of the date range selected.
Option Compare Database
Option Explicit
Dim mstrRepName As String
Private Sub Report_Activate()
Call Report_Page
End Sub
Private Sub Report_NoData(Cancel As Integer)
MsgBox "No data for the data range entered ... closing report"
Cancel = True
End Sub
Private Sub Report_Page()
On Error GoTo HandleErr
mstrRepName = Me!txtRepName
Call Get_RepData
Call Process_Rep_Data
ExitHere:
If Err.Number = 0 Then
Exit Sub
End If
HandleErr:
' display a message with the error number and description
MsgBox "Error Num: " & Err.Number & " Desc: " & Err.Description
Resume ExitHere
End Sub
Sub GetRep_Data()
Dim strSQL As String
On Error GoTo HandleDataErr
' delete data from tables
strSQL = "Delete * FROM tblUniverseRep;"
CurrentDb.Execute strSQL
strSQL = "Delete * FROM tblBldgRep;"
CurrentDb.Execute strSQL
strSQL = "Delete * FROM tblNonContactedRep;"
CurrentDb.Execute strSQL
strSQL = "INSERT INTO tblUniverseRep " _
& "SELECT tblCurrentTMReps.rep_name, informix_tm_contact.contact_date, " _
& "[50_bldg_sdl_qry_tbl_univ].pin, [50_bldg_sdl_qry_tbl_univ].mail_date, " _
& "informix_orders.order_date, informix_orders.demand_revenue, informix_orders_offers.offer_no " _
& "FROM (tblCurrentTMReps LEFT JOIN ((50_bldg_sdl_qry_tbl_univ RIGHT JOIN informix_tm_contact " _
& "ON [50_bldg_sdl_qry_tbl_univ].pin = informix_tm_contact.pin) LEFT JOIN (informix_names " _
& "LEFT JOIN informix_orders ON informix_names.account_no = informix_orders.account_no) " _
& "ON informix_tm_contact.pin = informix_names.pin) " _
& "ON tblCurrentTMReps.rep_name = informix_tm_contact.rep_name) " _
& "LEFT JOIN informix_orders_offers ON informix_orders.order_no = informix_orders_offers.order_no " _
& "WHERE ((tblCurrentTMReps.rep_name)= '" & mstrRepName & "'); "
CurrentDb.Execute strSQL
strSQL = "INSERT INTO tblBldgRep " _
& "SELECT tblCurrentTMReps.rep_name, informix_building.pin, " _
& "informix_tm_contact.contact_date, " _
& "informix_tm_contact.contact_expire_dt, informix_orders.order_date, " _
& "informix_orders.demand_revenue " _
& "FROM informix_building RIGHT JOIN ((tblCurrentTMReps LEFT JOIN (informix_tm_contact " _
& "LEFT JOIN (informix_names LEFT JOIN informix_orders ON informix_names.account_no = informix_orders.account_no) " _
& "ON informix_tm_contact.pin = informix_names.pin) ON tblCurrentTMReps.rep_name = informix_tm_contact.rep_name) " _
& "LEFT JOIN informix_orders_offers ON informix_orders.order_no = informix_orders_offers.order_no) " _
& "ON informix_building.pin = informix_tm_contact.pin " _
& "WHERE ((tblCurrentTMReps.rep_name)= '" & mstrRepName & "');"
CurrentDb.Execute strSQL
strSQL = "INSERT INTO tblNonContactedRep " _
& "SELECT tblBldgRep.rep_name, tblBldgRep.pin, " _
& "tblBldgRep.contact_date, tblBldgRep.contact_expire_dt, tblBldgRep.order_date, " _
& "tblBldgRep.demand_revenue, tblBldgRep.offer_no " _
& "FROM tblBldgRep LEFT JOIN tblUniverseRep " _
& "ON tblBldgRep.pin = tblUniverseRep.pin WHERE (((tblUniverseRep.pin) Is Null));"
CurrentDb.Execute strSQL
ExitDataHere:
If Err.Number = 0 Then
Exit Sub
End If
HandleDataErr:
' display a message with the error number and description
MsgBox "Error Num: " & Err.Number & " Desc: " & Err.Description
Resume ExitDataHere
End Sub
Private Sub Process_Rep_Data()
Dim rst As Recordset
Dim qdf As QueryDef
Dim prm As Parameter
Dim intContactsMade As Integer
Dim int1Time As Integer, int2Times As Integer, int3Times As Integer, int4Plus As Integer
On Error GoTo HandleProcessErr
intContactsMade = 0
int1Time = 0
int1Time2 = 0
int2Times = 0
int4Plus = 0
Set qdf = CurrentDb.QueryDefs("qryContactsMadeinDate_Prospects"
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
rst.MoveLast
intContactsMade = rst.RecordCount
Else
intContactsMade = 0
End If
rst.Close
qdf.Close
Set qdf = CurrentDb.QueryDefs("qryTotAcctsinDate_Prospects"
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
rst.MoveLast
Me!txtCtNumAccts = rst.RecordCount
Else
Me!txtCtNumAccts = 0
End If
rst.Close
qdf.Close
Me!txtProspNumAccts = (Me!txtCtNumAccts + Me!txtPriNumAccts)
Set qdf = CurrentDb.QueryDefs("qryTotAcctsinDate_Buyers"
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
rst.MoveLast
Me!txtCtNumAccts2 = rst.RecordCount
Else
Me!txtCtNumAccts2 = 0
End If
rst.Close
qdf.Close
Set qdf = CurrentDb.QueryDefs("qryTotAccts_NonContacted"
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
rst.MoveLast
Me!txtNoCtNumAccts = rst.RecordCount
Else
Me!txtNoCtNumAccts = 0
End If
rst.Close
qdf.Close
Me!txtGTNumAccts = (Me!txtNumAcctsSub + Me!txtNoCtNumAccts)
Set qdf = CurrentDb.QueryDefs("qryTotOrdersinDate_Prospects"
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
rst.MoveLast
Me!txtCtNumOrders = rst.RecordCount
Else
Me!txtCtNumOrders = 0
End If
rst.Close
qdf.Close
Me!txtProspNumOrders = (Me!txtCtNumOrders + Me!txtPriNumOrders)
Set qdf = CurrentDb.QueryDefs("qryTotOrders_NonContacted"
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
rst.MoveLast
Me!txtNoCtNumOrders = rst.RecordCount
Else
Me!txtNoCtNumOrders = 0
End If
rst.Close
qdf.Close
Me!txtGTNumOrders = (Me!txtNumOrdersSub + Me!txtNoCtNumOrders)
Set qdf = CurrentDb.QueryDefs("qryTotSalesinDate_Prospects"
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
Me!txtCtTotSales = Nz(rst.Fields("TotalSales"
, 0)
Else
Me!txtCtTotSales = 0#
End If
rst.Close
qdf.Close
Me!txtProspTotSales = (Me!txtCtTotSales + Me!txtPriTotSales)
Me!txtTotSalesSub = (Me!txtProspTotSales + Me!txtPastTotSales)
Set qdf = CurrentDb.QueryDefs("qryTotSales_NonContacted"
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
Me!txtNoCtTotSales = Nz(rst.Fields("TotalSales"
, 0)
Else
Me!txtNoCtTotSales = 0#
End If
rst.Close
qdf.Close
Me!txtGTTotSales = (Me!txtTotSalesSub + Me!txtNoCtTotSales)
Me!txtCtNumContacts = intContactsMade
Me!txtNumContactsSub = (Me!txtCtNumContacts + Me!txtCtNumContacts2)
Me!txtGTNumContacts = Me!txtNumContactsSub
Set qdf = CurrentDb.QueryDefs("qryContactsperAcctDistr_Prospects"
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
Do While Not rst.EOF
Select Case rst.Fields("ContactCount"
Case 1
int1Time = rst.Fields("Distribution"
Case 2
int2Times = rst.Fields("Distribution"
Case 3
int3Times = rst.Fields("Distribution"
Case 4
int4Plus = (int4Plus + rst.Fields("Distribution"
)
Case Else
int4Plus = (int4Plus + rst.Fields("Distribution"
)
End Select
rst.MoveNext
Loop
int4Plus = int4Plus
Else
int1Time = 0
int2Times = 0
int3Times = 0
int4Plus = 0
End If
rst.Close
qdf.Close
Me!txtCt1Time = int1Time
Me!txt1TimeSub = (Me!txtCt1Time + Me!txtCt1Time2)
Me!txtGT1Time = Me!txt1TimeSub
Me!txtCt2Times = int2Times
Me!txt2TimesSub = (Me!txtCt2Times + Me!txtCt2Times2)
Me!txtGT2Times = Me!txt2TimesSub
Me!txtCt3Times = int3Times
Me!txt3Timessub = (Me!txtCt3Times + Me!txtCt3Times2)
Me!txtGT3Times = Me!txt3Timessub
Me!txtCt4PlusTimes = int4Plus
Me!txt4PlusTimesSub = (Me!txtCt4PlusTimes + Me!txtCt4PlusTimes2)
Me!txtGT4PlusTimes = Me!txt4PlusTimesSub
Set qdf = CurrentDb.QueryDefs("qryCustsWhoPurch_Prospects"
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
rst.MoveLast
Me!txtCTCustsPurch = rst.RecordCount
Else
Me!txtCTCustsPurch = 0
End If
rst.Close
qdf.Close
Me!txtCustsPurchSub = (Me!txtCTCustsPurch + Me!txtCTCustsPurch2)
Me!txtGTCustsPurch = Me!txtCustsPurchSub
ExitProcessHere:
' set any existing objects to nothing
If Not rst Is Nothing Then
Set rst = Nothing
End If
If Not prm Is Nothing Then
Set prm = Nothing
End If
If Not qdf Is Nothing Then
Set qdf = Nothing
End If
If Err.Number = 0 Then
Exit Sub
End If
HandleProcessErr:
' display a message with the error number and description
MsgBox "Error Num: " & Err.Number & " Desc: " & Err.Description
Resume ExitProcessHere
End Sub
when I preview my report, all calculations on all pages are correct for the current rep name shown. However, when I click on the print button, the second page calcs now appear for the first rep name, and the second rep's calcs appear on each remaining page (there are 14 reps in all). the client's data base consists of 6 tables; the two largest (500,000 + records) being where the bulk of the data comes from. The relationships are not direct between the tables so I had to create an additional link table to get the correct data. I use several queries in the report and receive no errors while processing. It's just when I print that the report is not correct. As stated above, ; preview mode is fine. Any thoughts?
below is a sample of the vba code used. I use a form to get the report date range and call the report from it. I eliminated some of the calcs as they're the same as for the remaining code, just outside of the date range selected.
Option Compare Database
Option Explicit
Dim mstrRepName As String
Private Sub Report_Activate()
Call Report_Page
End Sub
Private Sub Report_NoData(Cancel As Integer)
MsgBox "No data for the data range entered ... closing report"
Cancel = True
End Sub
Private Sub Report_Page()
On Error GoTo HandleErr
mstrRepName = Me!txtRepName
Call Get_RepData
Call Process_Rep_Data
ExitHere:
If Err.Number = 0 Then
Exit Sub
End If
HandleErr:
' display a message with the error number and description
MsgBox "Error Num: " & Err.Number & " Desc: " & Err.Description
Resume ExitHere
End Sub
Sub GetRep_Data()
Dim strSQL As String
On Error GoTo HandleDataErr
' delete data from tables
strSQL = "Delete * FROM tblUniverseRep;"
CurrentDb.Execute strSQL
strSQL = "Delete * FROM tblBldgRep;"
CurrentDb.Execute strSQL
strSQL = "Delete * FROM tblNonContactedRep;"
CurrentDb.Execute strSQL
strSQL = "INSERT INTO tblUniverseRep " _
& "SELECT tblCurrentTMReps.rep_name, informix_tm_contact.contact_date, " _
& "[50_bldg_sdl_qry_tbl_univ].pin, [50_bldg_sdl_qry_tbl_univ].mail_date, " _
& "informix_orders.order_date, informix_orders.demand_revenue, informix_orders_offers.offer_no " _
& "FROM (tblCurrentTMReps LEFT JOIN ((50_bldg_sdl_qry_tbl_univ RIGHT JOIN informix_tm_contact " _
& "ON [50_bldg_sdl_qry_tbl_univ].pin = informix_tm_contact.pin) LEFT JOIN (informix_names " _
& "LEFT JOIN informix_orders ON informix_names.account_no = informix_orders.account_no) " _
& "ON informix_tm_contact.pin = informix_names.pin) " _
& "ON tblCurrentTMReps.rep_name = informix_tm_contact.rep_name) " _
& "LEFT JOIN informix_orders_offers ON informix_orders.order_no = informix_orders_offers.order_no " _
& "WHERE ((tblCurrentTMReps.rep_name)= '" & mstrRepName & "'); "
CurrentDb.Execute strSQL
strSQL = "INSERT INTO tblBldgRep " _
& "SELECT tblCurrentTMReps.rep_name, informix_building.pin, " _
& "informix_tm_contact.contact_date, " _
& "informix_tm_contact.contact_expire_dt, informix_orders.order_date, " _
& "informix_orders.demand_revenue " _
& "FROM informix_building RIGHT JOIN ((tblCurrentTMReps LEFT JOIN (informix_tm_contact " _
& "LEFT JOIN (informix_names LEFT JOIN informix_orders ON informix_names.account_no = informix_orders.account_no) " _
& "ON informix_tm_contact.pin = informix_names.pin) ON tblCurrentTMReps.rep_name = informix_tm_contact.rep_name) " _
& "LEFT JOIN informix_orders_offers ON informix_orders.order_no = informix_orders_offers.order_no) " _
& "ON informix_building.pin = informix_tm_contact.pin " _
& "WHERE ((tblCurrentTMReps.rep_name)= '" & mstrRepName & "');"
CurrentDb.Execute strSQL
strSQL = "INSERT INTO tblNonContactedRep " _
& "SELECT tblBldgRep.rep_name, tblBldgRep.pin, " _
& "tblBldgRep.contact_date, tblBldgRep.contact_expire_dt, tblBldgRep.order_date, " _
& "tblBldgRep.demand_revenue, tblBldgRep.offer_no " _
& "FROM tblBldgRep LEFT JOIN tblUniverseRep " _
& "ON tblBldgRep.pin = tblUniverseRep.pin WHERE (((tblUniverseRep.pin) Is Null));"
CurrentDb.Execute strSQL
ExitDataHere:
If Err.Number = 0 Then
Exit Sub
End If
HandleDataErr:
' display a message with the error number and description
MsgBox "Error Num: " & Err.Number & " Desc: " & Err.Description
Resume ExitDataHere
End Sub
Private Sub Process_Rep_Data()
Dim rst As Recordset
Dim qdf As QueryDef
Dim prm As Parameter
Dim intContactsMade As Integer
Dim int1Time As Integer, int2Times As Integer, int3Times As Integer, int4Plus As Integer
On Error GoTo HandleProcessErr
intContactsMade = 0
int1Time = 0
int1Time2 = 0
int2Times = 0
int4Plus = 0
Set qdf = CurrentDb.QueryDefs("qryContactsMadeinDate_Prospects"
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
rst.MoveLast
intContactsMade = rst.RecordCount
Else
intContactsMade = 0
End If
rst.Close
qdf.Close
Set qdf = CurrentDb.QueryDefs("qryTotAcctsinDate_Prospects"
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
rst.MoveLast
Me!txtCtNumAccts = rst.RecordCount
Else
Me!txtCtNumAccts = 0
End If
rst.Close
qdf.Close
Me!txtProspNumAccts = (Me!txtCtNumAccts + Me!txtPriNumAccts)
Set qdf = CurrentDb.QueryDefs("qryTotAcctsinDate_Buyers"
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
rst.MoveLast
Me!txtCtNumAccts2 = rst.RecordCount
Else
Me!txtCtNumAccts2 = 0
End If
rst.Close
qdf.Close
Set qdf = CurrentDb.QueryDefs("qryTotAccts_NonContacted"
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
rst.MoveLast
Me!txtNoCtNumAccts = rst.RecordCount
Else
Me!txtNoCtNumAccts = 0
End If
rst.Close
qdf.Close
Me!txtGTNumAccts = (Me!txtNumAcctsSub + Me!txtNoCtNumAccts)
Set qdf = CurrentDb.QueryDefs("qryTotOrdersinDate_Prospects"
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
rst.MoveLast
Me!txtCtNumOrders = rst.RecordCount
Else
Me!txtCtNumOrders = 0
End If
rst.Close
qdf.Close
Me!txtProspNumOrders = (Me!txtCtNumOrders + Me!txtPriNumOrders)
Set qdf = CurrentDb.QueryDefs("qryTotOrders_NonContacted"
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
rst.MoveLast
Me!txtNoCtNumOrders = rst.RecordCount
Else
Me!txtNoCtNumOrders = 0
End If
rst.Close
qdf.Close
Me!txtGTNumOrders = (Me!txtNumOrdersSub + Me!txtNoCtNumOrders)
Set qdf = CurrentDb.QueryDefs("qryTotSalesinDate_Prospects"
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
Me!txtCtTotSales = Nz(rst.Fields("TotalSales"
Else
Me!txtCtTotSales = 0#
End If
rst.Close
qdf.Close
Me!txtProspTotSales = (Me!txtCtTotSales + Me!txtPriTotSales)
Me!txtTotSalesSub = (Me!txtProspTotSales + Me!txtPastTotSales)
Set qdf = CurrentDb.QueryDefs("qryTotSales_NonContacted"
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
Me!txtNoCtTotSales = Nz(rst.Fields("TotalSales"
Else
Me!txtNoCtTotSales = 0#
End If
rst.Close
qdf.Close
Me!txtGTTotSales = (Me!txtTotSalesSub + Me!txtNoCtTotSales)
Me!txtCtNumContacts = intContactsMade
Me!txtNumContactsSub = (Me!txtCtNumContacts + Me!txtCtNumContacts2)
Me!txtGTNumContacts = Me!txtNumContactsSub
Set qdf = CurrentDb.QueryDefs("qryContactsperAcctDistr_Prospects"
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
Do While Not rst.EOF
Select Case rst.Fields("ContactCount"
Case 1
int1Time = rst.Fields("Distribution"
Case 2
int2Times = rst.Fields("Distribution"
Case 3
int3Times = rst.Fields("Distribution"
Case 4
int4Plus = (int4Plus + rst.Fields("Distribution"
Case Else
int4Plus = (int4Plus + rst.Fields("Distribution"
End Select
rst.MoveNext
Loop
int4Plus = int4Plus
Else
int1Time = 0
int2Times = 0
int3Times = 0
int4Plus = 0
End If
rst.Close
qdf.Close
Me!txtCt1Time = int1Time
Me!txt1TimeSub = (Me!txtCt1Time + Me!txtCt1Time2)
Me!txtGT1Time = Me!txt1TimeSub
Me!txtCt2Times = int2Times
Me!txt2TimesSub = (Me!txtCt2Times + Me!txtCt2Times2)
Me!txtGT2Times = Me!txt2TimesSub
Me!txtCt3Times = int3Times
Me!txt3Timessub = (Me!txtCt3Times + Me!txtCt3Times2)
Me!txtGT3Times = Me!txt3Timessub
Me!txtCt4PlusTimes = int4Plus
Me!txt4PlusTimesSub = (Me!txtCt4PlusTimes + Me!txtCt4PlusTimes2)
Me!txtGT4PlusTimes = Me!txt4PlusTimesSub
Set qdf = CurrentDb.QueryDefs("qryCustsWhoPurch_Prospects"
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset(dbOpenDynaset)
If Not rst.BOF And Not rst.EOF Then
rst.MoveLast
Me!txtCTCustsPurch = rst.RecordCount
Else
Me!txtCTCustsPurch = 0
End If
rst.Close
qdf.Close
Me!txtCustsPurchSub = (Me!txtCTCustsPurch + Me!txtCTCustsPurch2)
Me!txtGTCustsPurch = Me!txtCustsPurchSub
ExitProcessHere:
' set any existing objects to nothing
If Not rst Is Nothing Then
Set rst = Nothing
End If
If Not prm Is Nothing Then
Set prm = Nothing
End If
If Not qdf Is Nothing Then
Set qdf = Nothing
End If
If Err.Number = 0 Then
Exit Sub
End If
HandleProcessErr:
' display a message with the error number and description
MsgBox "Error Num: " & Err.Number & " Desc: " & Err.Description
Resume ExitProcessHere
End Sub