Access Report keeps repeating last record.

[fperri]

I have a form where the user selects values that I use as filters to populate a report for them. The report has VB code behind it so that it can be dynamic to all the different filters that the user selects. For some reason, when the user selects more than one lender (or column when on the report), it populates the report correctly but then repeats the last record over and over. I'm completely lost as to why it is doing this. It worked in the begining fine, but now (probably after I made some change that I can't remember) it is not working correctly.

It is a lot of code so if anyone is interested in looking at it just let me know and I'll post the code.

Thanks

[MMcCarthy]

I have a form where the user selects values that I use as filters to populate a report for them. The report has VB code behind it so that it can be dynamic to all the different filters that the user selects. For some reason, when the user selects more than one lender (or column when on the report), it populates the report correctly but then repeats the last record over and over. I'm completely lost as to why it is doing this. It worked in the begining fine, but now (probably after I made some change that I can't remember) it is not working correctly.

It is a lot of code so if anyone is interested in looking at it just let me know and I'll post the code.

Thanks

You'll need to post the relevant code for anyone to work out what's going on.

Start with the code used to filter the report. Also provide the sql for the query being used as the record source of the report.

[fperri]

You'll need to post the relevant code for anyone to work out what's going on.

Start with the code used to filter the report. Also provide the sql for the query being used as the record source of the report.

For some reason its not letting me post code. Says my message needs to be longer than 20 characters, but its way more than that.

[MMcCarthy]

For some reason its not letting me post code. Says my message needs to be longer than 20 characters, but its way more than that.

I'm not sure what the problem is. Are you putting tags on your code?

[fperri]

Yes, I tried it with and without the code tags. Do you think it has something to do with copying and pasting the code into the window?

[MMcCarthy]

Yes, I tried it with and without the code tags. Do you think it has something to do with copying and pasting the code into the window?

At a guess I would say yes. Try pasting it to notepad first.

[fperri]

At a guess I would say yes. Try pasting it to notepad first.

The user selects different filters for the report then clicks a button to generate the report. This is the code that grabs the data based on their selections, then looks in tables that have adjustments and applieds the adjustments.

 'CLEAR OUT TEMPORARY TABLE
sqlTxt = "DELETE tmpRates.* FROM tmpRates"
DoCmd.RunSQL sqlTxt
 
'POPULATE TEMPORARY TABLE WITH BASE RATES FOR LENDERS AND LOAN NAME SELECTED
sqlTxt = "INSERT INTO tmpRATES ( LENDER, CHANNEL, MARGIN, HGI, [LOAN NAME], RATE, PRICING )" & _
        " SELECT RATES.LENDER, RATES.CHANNEL, RATES.MARGIN, RATES.HGI, RATES.[LOAN NAME], RATES.RATE, RATES.PRICING" & _
        " FROM RATES" & _
        " WHERE (((RATES.[LOAN NAME])= '" & loanSelected & "') AND ("
 
For i = 0 To lendersCounter1 - 1
    If lendersCounter3 > 1 Then
        If i < 1 Then
        sqlTxt = sqlTxt + " ((RATES.LENDER)= '" & lendersSelected(lendersCounter2 - 1) & "')"
        Else
        sqlTxt = sqlTxt + " OR ((RATES.LENDER) = '" & lendersSelected(lendersCounter2 - 1) & "')"
        End If
    Else
        sqlTxt = sqlTxt + " ((RATES.LENDER) = '" & lendersSelected(lendersCounter2 - 1) & "')"
    End If
    lendersCounter2 = lendersCounter2 - 1
Next i
 
sqlTxt = sqlTxt + ") AND (RATES.RATE > " & minRate & ")"
sqlTxt = sqlTxt + " AND (RATES.RATE < " & maxRate
 
sqlTxt = sqlTxt + "));"
 
'MsgBox sqlTxt
 
DoCmd.RunSQL sqlTxt
Set recSet = CurrentDb.OpenRecordset("tmpRates")
If recSet.EOF Then
    MsgBox "The database does not contain any records for the criteria provided.", vbOKOnly, "No Records Found."
    recSet.Close
    Exit Sub
End If
'*****************************'
'   APPLY (C)LTV ADJUSTMENTS  '
'*****************************'
'CLEAR OUT ADJUSTMENT TABLE
sqlTxt = "DELETE tmpAdjustments.* FROM tmpAdjustments"
DoCmd.RunSQL sqlTxt
 
'IF CLTV ENTERED USE THIS CODE
    If cltvFlag = True Then
      sqlTxt = "INSERT INTO tmpAdjustments ( Lender, [LOAN NAME], FEE_ADJ, RATE_ADJ, [MIN FICO], [MAX FICO], MIN_LTV, MAX_LTV, MIN_CLTV, MAX_CLTV)" & _
                " SELECT [COMPLETE CLTV].Lender, [COMPLETE CLTV].[LOAN NAME], [COMPLETE CLTV].FEE_ADJ, [COMPLETE CLTV].RATE_ADJ, [COMPLETE CLTV].[MIN FICO], [COMPLETE CLTV].[MAX FICO], [COMPLETE CLTV].MIN_LTV, [COMPLETE CLTV].MAX_LTV, [COMPLETE CLTV].MIN_CLTV, [COMPLETE CLTV].MAX_CLTV" & _
                " FROM [COMPLETE CLTV] INNER JOIN tmpRATES ON (tmpRATES.[LOAN NAME] = [COMPLETE CLTV].[LOAN NAME]) AND ([COMPLETE CLTV].Lender = tmpRATES.LENDER)" & _
                " WHERE ((([COMPLETE CLTV].MIN_CLTV) <= " & cLTV
                sqlTxt = sqlTxt + ") And (([COMPLETE CLTV].MAX_CLTV) >= " & cLTV
                sqlTxt = sqlTxt + ") And (([COMPLETE CLTV].MIN_LTV) <= " & ltvAmt
                sqlTxt = sqlTxt + ") And (([COMPLETE CLTV].MAX_LTV) >= " & ltvAmt
                sqlTxt = sqlTxt + ") And (([COMPLETE CLTV].[MIN FICO]) <= " & ficoScore
                sqlTxt = sqlTxt + ") And (([COMPLETE CLTV].[MAX FICO]) >= " & ficoScore
                sqlTxt = sqlTxt + ")) GROUP BY [COMPLETE CLTV].Lender, [COMPLETE CLTV].[LOAN NAME], [COMPLETE CLTV].FEE_ADJ, [COMPLETE CLTV].RATE_ADJ, [COMPLETE CLTV].[MIN FICO], [COMPLETE CLTV].[MAX FICO], [COMPLETE CLTV].MIN_LTV, [COMPLETE CLTV].MAX_LTV, [COMPLETE CLTV].MIN_CLTV, [COMPLETE CLTV].MAX_CLTV;"
        'MsgBox sqlTxt
        DoCmd.RunSQL sqlTxt
End If
 
    Set adjustmentRecordSet = CurrentDb.OpenRecordset("tmpAdjustments")
 
If there were no (C)LTV adjustment retrieved then mark the LTV adjustment Fields in the tmpRates table to zero.
    If adjustmentRecordSet.EOF Then
        recSet.MoveFirst
            Do Until recSet.EOF
                With recSet
                        recSet.Edit
                        recSet.Fields("LTV_Adjustment_Fee").Value = 0
                        recSet.Fields("LTV_Adjustment_Rate").Value = 0
                        recSet.Fields("LTV").Value = ltvAmt
                        recSet.Fields("CLTV").Value = cLTV
                        recSet.Update
                End With
                recSet.MoveNext
            Loop
    'If there were (C)LTV adjustment retrieved then updated the values in the tmpRates table
    Else
        recSet.MoveFirst
        adjustmentRecordSet.MoveFirst
        Do Until adjustmentRecordSet.EOF
            Do Until recSet.EOF
                If recSet.Fields("LENDER").Value = adjustmentRecordSet.Fields("LENDER").Value Then
                With recSet
                    recSet.Edit
                    recSet.Fields("LTV_Adjustment_Fee").Value = recSet.Fields("LTV_Adjustment_Fee").Value + adjustmentRecordSet.Fields("FEE_ADJ").Value
                    recSet.Fields("LTV_Adjustment_Rate").Value = recSet.Fields("LTV_Adjustment_Rate").Value + adjustmentRecordSet.Fields("RATE_ADJ").Value
                    recSet.Fields("LTV").Value = ltvAmt
                    recSet.Fields("CLTV").Value = cLTV
                    recSet.Update
                End With
                End If
                recSet.MoveNext
            Loop
            adjustmentRecordSet.MoveNext
            recSet.MoveFirst
        Loop
    End If
 
    adjustmentRecordSet.Close
'***************************'
'   APPLY FICO ADJUSTMENTS  '
'***************************'
 
    'CLEAR OUT ADJUSTMENT TABLE
    sqlTxt = "DELETE tmpAdjustments.* FROM tmpAdjustments"
    DoCmd.RunSQL sqlTxt
 
    'GET ADJUSTMENTS FROM COMPLETE FICO TABLE
 
    If cltvFlag = False Then
 
    sqlTxt = "INSERT INTO tmpAdjustments ( LENDER, [LOAN NAME], [MIN FICO], [MAX FICO], MIN_LTV, MAX_LTV, FEE_ADJ, RATE_ADJ )" & _
            " SELECT [COMPLETE FICO].Lender, [COMPLETE FICO].[LOAN NAME], [COMPLETE FICO].MIN_FICO, [COMPLETE FICO].MAX_FICO, [COMPLETE FICO].MIN_LTV, [COMPLETE FICO].MAX_LTV, [COMPLETE FICO].FEE_ADJ, [COMPLETE FICO].RATE_ADJ" & _
            " FROM tmpRATES INNER JOIN [COMPLETE FICO] ON (tmpRATES.LENDER = [COMPLETE FICO].Lender) AND (tmpRATES.[LOAN NAME] = [COMPLETE FICO].[LOAN NAME])" & _
            " GROUP BY [COMPLETE FICO].Lender, [COMPLETE FICO].[LOAN NAME], [COMPLETE FICO].MIN_FICO, [COMPLETE FICO].MAX_FICO, [COMPLETE FICO].MIN_LTV, [COMPLETE FICO].MAX_LTV, [COMPLETE FICO].FEE_ADJ, [COMPLETE FICO].RATE_ADJ" & _
            " HAVING ((([COMPLETE FICO].MIN_FICO)<= " & ficoScore
            sqlTxt = sqlTxt + ") AND (([COMPLETE FICO].MAX_FICO)>= " & ficoScore
            sqlTxt = sqlTxt + ") AND (([COMPLETE FICO].MIN_LTV)<= " & ltvAmt
            sqlTxt = sqlTxt + ") AND (([COMPLETE FICO].MAX_LTV)>= " & ltvAmt
            sqlTxt = sqlTxt + "));"
    DoCmd.RunSQL sqlTxt
 
    End If
 
    If cltvFlag = True Then
 
    sqlTxt = "INSERT INTO tmpAdjustments ( LENDER, [LOAN NAME], [MIN FICO], [MAX FICO], MIN_LTV, MAX_LTV, FEE_ADJ, RATE_ADJ )" & _
            " SELECT [COMPLETE FICO].Lender, [COMPLETE FICO].[LOAN NAME], [COMPLETE FICO].MIN_FICO, [COMPLETE FICO].MAX_FICO, [COMPLETE FICO].MIN_LTV, [COMPLETE FICO].MAX_LTV, [COMPLETE FICO].FEE_ADJ, [COMPLETE FICO].RATE_ADJ" & _
            " FROM tmpRATES INNER JOIN [COMPLETE FICO] ON (tmpRATES.LENDER = [COMPLETE FICO].Lender) AND (tmpRATES.[LOAN NAME] = [COMPLETE FICO].[LOAN NAME])" & _
            " GROUP BY [COMPLETE FICO].Lender, [COMPLETE FICO].[LOAN NAME], [COMPLETE FICO].MIN_FICO, [COMPLETE FICO].MAX_FICO, [COMPLETE FICO].MIN_LTV, [COMPLETE FICO].MAX_LTV, [COMPLETE FICO].FEE_ADJ, [COMPLETE FICO].RATE_ADJ" & _
            " HAVING ((([COMPLETE FICO].MIN_FICO)<= " & ficoScore
            sqlTxt = sqlTxt + ") AND (([COMPLETE FICO].MAX_FICO)>= " & ficoScore
            sqlTxt = sqlTxt + ") AND (([COMPLETE FICO].MIN_LTV)<= " & cLTV
            sqlTxt = sqlTxt + ") AND (([COMPLETE FICO].MAX_LTV)>= " & cLTV
            sqlTxt = sqlTxt + "));"
    DoCmd.RunSQL sqlTxt
 
    End If
 
    Set adjustmentRecordSet = CurrentDb.OpenRecordset("tmpAdjustments")
 
    'ADD ADJUSTMENTS TO tmpRATES TABLE
    If adjustmentRecordSet.EOF Then
        recSet.MoveFirst
            Do Until recSet.EOF
                With recSet
                recSet.Edit
                    recSet.Fields("FICO_Adjustment_Fee").Value = 0
                    recSet.Fields("FICO_Adjustment_Rate").Value = 0
                    recSet.Fields("FICO").Value = ficoScore
                    recSet.Update
                End With
                recSet.MoveNext
            Loop
    Else
        recSet.MoveFirst
        adjustmentRecordSet.MoveFirst
        Do Until adjustmentRecordSet.EOF
            Do Until recSet.EOF
                If recSet.Fields("LENDER").Value = adjustmentRecordSet.Fields("LENDER").Value Then
                With recSet
                    recSet.Edit
                    recSet.Fields("FICO_Adjustment_Fee").Value = recSet.Fields("FICO_Adjustment_Fee").Value + adjustmentRecordSet.Fields("FEE_ADJ").Value
                    recSet.Fields("FICO_Adjustment_Rate").Value = recSet.Fields("FICO_Adjustment_Rate").Value + adjustmentRecordSet.Fields("RATE_ADJ").Value
                    recSet.Fields("FICO").Value = ficoScore
                    recSet.Update
                End With
                End If
                recSet.MoveNext
            Loop
            adjustmentRecordSet.MoveNext
            recSet.MoveFirst
        Loop
    End If
 
    adjustmentRecordSet.Close
 
 
 
'CONTINUES THE SAME FOR FOUR MORE ADJUSTMENT TABLES THEN ENDS WITH
 
 
    adjustmentRecordSet.Close
 
    recSet.Close
 
    sqlTxt = "DELETE tmpRATES.LENDER, tmpRATES.CHANNEL, tmpRATES.[LOAN NAME], tmpRATES.DOC_TYPE, tmpRATES.PROP_TYPE, tmpRATES.PURPOSE, tmpRATES.LOAN_AMT, tmpRATES.OCC, tmpRATES.LTV, tmpRATES.FICO, tmpRATES.HGI, tmpRATES.MARGIN, tmpRATES.RATE, tmpRATES.PRICING, tmpRATES.PRICING, tmpRATES.LTV_Adjustment_Rate, tmpRATES.LTV_Adjustment_Fee, tmpRATES.FICO_Adjustment_Rate, tmpRATES.FICO_Adjustment_Fee, tmpRATES.DocType_Adjustment_Rate, tmpRATES.DocType_Adjustment_Fee, tmpRATES.PropType_Adjustment_Rate, tmpRATES.PropType_Adjustment_Fee, tmpRATES.Purpose_Adjustment_Rate, tmpRATES.Purpose_Adjustment_Fee, tmpRATES.OCC_Adjustment_Rate, tmpRATES.OCC_Adjustment_Fee, tmpRATES.OCC_Adjustment_Fee, tmpRATES.LoanAmt_Adjustment_Rate, tmpRATES.LoanAmt_Adjustment_Fee" & _
            " FROM tmpRATES" & _
            " WHERE (((tmpRATES.RATE)=0)) OR (((tmpRATES.RATE) Is Null));"
    DoCmd.RunSQL sqlTxt
 
    Me.Visible = False
 
    DoCmd.OpenReport ("Expanded Criteria Pricing Comparison"), acViewPreview, , , acWindowNormal
 

So that's the code on the form that does the meaty stuff. In the database there is a pivot query that uses the tmpRates table populated in this code. The report uses this pivot query to pull the data. I'll post the code for the report next.

I'm sure there was probably a shorter way to go about this but I'm a newbie so I just tried to do what I knew how to - to get it to work.....so please be nice :)

[fperri]

I'm removing this message because the code showed up alll screwy.

[fperri]

Here is the code on the report.

Option Compare Database
 '  Constant for maximum number of columns 
   Const conTotalColumns = 14
 
   '  Variables for Database object and Recordset.
   Dim dbsReport As DAO.Database
   Dim rstReport As DAO.Recordset
 
   '  Variables for number of columns and row and report totals.
   Dim intColumnCount As Integer
   Dim columnRank(1 To conTotalColumns - 1) As Double
   Dim columnName(1 To conTotalColumns - 1) As String
   Dim columnValue() As Double
   Dim tmpColumnValue(1 To conTotalColumns - 1) As Double
   Dim valueCounter1 As Integer
   Dim valueCounter2 As Integer
   Dim Holder As Double
   Dim rankRate As Double
   Dim rateCounter As Integer
   Dim oddEven As String
   Dim tmp As Integer
   Dim minVal As Double
   Dim maxVal As Double
   Dim medVal As Double
   Dim counter As Integer
   Dim a As Integer
   Dim processedFlag As Boolean
   Dim holderOne As Double
   Dim holderTwo As Double
   Dim columnCount As Integer
   Dim J As Integer
   Dim X As Integer
   Dim K As Integer
 
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)
 
   minVal = 0
   maxVal = 0
   medVal = 0
 
   Dim intX As Integer
   '  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
         K = 1
         For intX = 1 To intColumnCount
 
            Me("Col" + Format(intX)) = xtabCnulls(rstReport(intX - 1))
 
            'Get Minimum value
            If intX > 1 Then
                If xtabCnulls(rstReport(intX - 1)) = 0 Then
                    minVal = minVal
                Else
                    If intX = 2 Then
                        minVal = xtabCnulls(rstReport(intX - 1))
                    Else
                        If minVal < xtabCnulls(rstReport(intX - 1)) Then
                            minVal = minVal
                        Else
                            minVal = xtabCnulls(rstReport(intX - 1))
                        End If
                    End If
                End If
            End If
 
            'Get Maximum Value
            If intX > 1 Then
                If xtabCnulls(rstReport(intX - 1)) = 0 Then
                    maxVal = maxVal
                Else
                    If intX = 2 Then
                        maxVal = xtabCnulls(rstReport(intX - 1))
                    Else
                        If maxVal = 0 Then
                            maxVal = xtabCnulls(rstReport(intX - 1))
                        Else
                            If maxVal > xtabCnulls(rstReport(intX - 1)) Then
                                maxVal = maxVal
                            Else
                                maxVal = xtabCnulls(rstReport(intX - 1))
                            End If
                        End If
                    End If
                End If
            End If
 
            'Get Median
            If intX > 1 And xtabCnulls(rstReport(intX - 1)) <> 0 Then
                counter = counter + 1
                medVal = medVal + xtabCnulls(rstReport(intX - 1))
            End If
 
            If intX > 1 Then
                If Me("Col1") = rankRate Then
                        Holder = xtabCnulls(rstReport(intX - 1))
                        If Holder = 0 Then
                            'Do nothing
                        Else
                            columnName(intX) = "Col" & (intX)
                            columnRank(intX) = xtabCnulls(rstReport(intX - 1))
                            tmpColumnValue(K) = xtabCnulls(rstReport(intX - 1))
                            valueCounter1 = valueCounter1 + 1
                            K = K + 1
                        End If
                End If
            End If
        Next intX
 
 
         '  Hide unused text boxes in the "Detail" section.
         For intX = intColumnCount + 4 To conTotalColumns
            Me("Col" + Format(intX)).Visible = False
         Next intX
 
 
         'Check for middle rate to highlight
         If Me("Col1") = rankRate Then
            'Highlight the row
            Me("Line49").Visible = True
            Me("Line50").Visible = True
            processedFlag = True
         Else
            Me("Line49").Visible = False
            Me("Line50").Visible = False
            processedFlag = False
         End If
 
         '  Move to next record in recordset.
         rstReport.MoveNext
      End If
   End If
 
 
 
'Grabbing Values for rank
If processedFlag = True Then
 
    ReDim columnValue(valueCounter1 - 1)
 
 
    a = 0
 
' Grabbing values for rank
    For i = 1 To valueCounter1
        If tmpColumnValue(i) <> 0 Then
            columnValue(a) = tmpColumnValue(i)
            valueCounter2 = valueCounter2 + 1
            a = a + 1
        End If
    Next i
' Putting values in order of rank - from the end of the array to the begining of the array
    For X = 1 To 10
        For J = valueCounter1 - 1 To 1 Step -1
            If J <> 0 Then
                If columnValue(J) < columnValue(J - 1) Then
                    holderOne = columnValue(J)
                    holderTwo = columnValue(J - 1)
                    columnValue(J) = holderTwo
                    columnValue(J - 1) = holderOne
                End If
            End If
        Next J
    Next X
' Putting values in order of rank = from the begining of the array to the end of the array
   For X = 1 To 10
        For J = 0 To valueCounter1 - 1
            If J = valueCounter1 - 1 Then
                'Do Nothing
 
            Else
                If columnValue(J) > columnValue(J + 1) Then
                    holderOne = columnValue(J)
                    holderTwo = columnValue(J + 1)
                    columnValue(J) = holderTwo
                    columnValue(J + 1) = holderOne
                End If
            End If
        Next J
   Next X
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
      ' Compute Median
         If medVal = maxVal And medVal = minVal Then
            medVal = medVal
         Else
            medVal = medVal / counter
         End If
 
         ' Put Min, Max & Median Values into Fields
         Me("Col" + Format(intColumnCount + 1)) = maxVal
         Me("Col" + Format(intColumnCount + 1)).Visible = True
         Me("Col" + Format(intColumnCount + 2)) = minVal
         Me("Col" + Format(intColumnCount + 2)).Visible = True
         Me("Col" + Format(intColumnCount + 3)) = medVal
         Me("Col" + Format(intColumnCount + 3)).Visible = True
 
 
 
         maxVal = 0
         minVal = 0
         medVal = 0
   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
 
   '  Put column headings into text boxes in page header.
   For intX = 1 To intColumnCount
      Me("Head" + Format(intX)) = rstReport(intX - 1).Name
   Next intX
 
   '  Make next available text boxes min, max & Median
   'Me("Head" + Format(intColumnCount + 1)) = "Totals"
   Me("Head" + Format(intColumnCount + 1)) = "Highest"
   Me("Head" + Format(intColumnCount + 1)).Visible = True
   Me("Head" + Format(intColumnCount + 2)) = "Lowest"
   Me("Head" + Format(intColumnCount + 2)).Visible = True
   Me("Head" + Format(intColumnCount + 3)) = "Median"
   Me("Head" + Format(intColumnCount + 3)).Visible = True
 
   '  Hide unused text boxes in page header.
   For intX = (intColumnCount + 4) To conTotalColumns
      Me("Head" + Format(intX)).Visible = False
   Next intX
 
End Sub
 
 
Private Sub Report_Close()
 
   On Error Resume Next
 
   '  Close recordset.
   rstReport.Close
   'DoCmd.openForm ("Comp_Report")
   [Forms]![Comp_Report].[Visible] = True
   My.Form.Comp_Report.Visible = True
 
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)
 
   '  Create underlying recordset for report using pivotRatesOnly Query
 
   Dim intX As Integer
   Dim qdf As QueryDef
   Dim frm As Form
 
   '  Set database variable to current database.
   Set dbsReport = CurrentDb
   'Set frm = Forms!EmployeeSalesDialogBox
   '  Open QueryDef object.
   Set qdf = dbsReport.QueryDefs("pivotRatesOnly")
 
   '  Open Recordset object.
   Set rstReport = qdf.OpenRecordset()
 
   '  Set a variable to hold number of columns in crosstab query.
   intColumnCount = rstReport.Fields.Count
 
   If Not rstReport.EOF Then
           ' Get number of rates selected
   Do Until rstReport.EOF
        rateCounter = rateCounter + 1
        rstReport.MoveNext
   Loop
 
   rstReport.MoveFirst
 
   ' Find out if the number is odd or even
   If num Mod rateCounter = 0 Then
        oddEven = "Even"
   Else
        oddEven = "Odd"
   End If
 
   ' If it is an even count -
   If oddEven = "Even" Then
        'Divide rateCounter by two
        rateCounter = rateCounter / 2
            'Loop to that number
            For i = 0 To rateCounter
                ' Once we are at that number
                If i = rateCounter Then
                    ' Tak that rate - The 1st middle value
                    rankRate = rstReport.Fields("RATE").Value
                    'MsgBox rankRate
                Else
                    rstReport.MoveNext
                End If
            Next i
    End If
 
    ' If it is an odd count -
    If oddEven = "Odd" Then
        'Divide rateCounter by two
        rateCounter = rateCounter / 2
        'Strip what is after the decimal point and round to the next number
        tmp = Val(rateCounter)
            If rateCounter - tmp >= 0.5 Then
                rateCounter = tmp + 1
            Else
                rateCounter = tmp
            End If
        'Loop to that number
            For i = 0 To rateCounter
                ' Once we are at that number
                If i = rateCounter Then
                    ' Tak that rate - The 1st middle value
                    rankRate = rstReport.Fields("RATE").Value
                    MsgBox rankRate
                Else
                    rstReport.MoveNext
                End If
            Next i
    End If
 
rstReport.MoveFirst
End If    
End Sub
 

[LacrosseB0ss]

does the code repeat the last record an infinite number of times? I.E. Do you need to hit "CTRL + BREAK" to make it stop? Or is there a fixed amount of times?

If it's infinite, check your looping end conditions. If it's fixed, you will need some deeper digging.

Hope this helps
- LB

[fperri]

Here is the rest......

Private Sub ReportFooter_Print(Cancel As Integer, PrintCount As Integer)
 
   Dim intX As Integer
   Dim X As Integer
 
   '  Put rank value in text boxes in report footer.
   '  Start at column 2 (first text box with crosstab value).
 
 
        For X = 0 To valueCounter1 - 1
            For i = 1 To 10
                If columnRank(i) = columnValue(X) Then
                    Me("Tot" + Format(i)) = X + 1
                End If
            Next i
        Next X
 
   '  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.MoveFirst
 
   'Initialize variables.
   InitVars
 
End Sub

It all works, cept its repeating the last record in the report over and over giving me and extra page of the same values throughout. I ran the report a bunch of times to try and see if there was a link between how many times it was repeated but I couldn't find anything. But I did notice when stepping throught the code that after it gets to the end of the recordset it keeps going through the process. I think that this is where the repeated records are coming from but I can't figure out what code to change or add to get it to stop.

[MMcCarthy]

Look at the placement of the MoveNext in your Report Open procedure. Follow the logic and see if the recordset will move under those conditions.

[fperri]

Look at the placement of the MoveNext in your Report Open procedure. Follow the logic and see if the recordset will move under those conditions.

There is no MoveNext in the Report Open procedure. There is a move next in the detail format through.

I just stepped through the code again (Line by line) as it was pulling up the report. It goes throught the recordset fine, but when it reaches the end of the recordset it keeps going back and forth between the detail_format and detail_print procedures without doing anything - I mean, without processing any of the code because it is the end of the recordset - so, it just pops back and forth until finally it stops for some unknow reason to me - so the final recordset record is getting repeated.

I'm wondering if it has anything to do with the formatCount and printCount variables? The code is written to execute when the printCount or formatCount is 1, but only access can change this value. I can't figure out what triggers the code to finally stop but I'm guessing it stops when one of these gets changed to zero, but I can't change the value because it is a read only.

So, I added a boolean flag that I change to true if it is the end of the recordset and put an if statment arount the code in the detailPrint procedure for it to only run if the flag is false otherwise exit the sub. It worked the very first time I ran it after adding the code and it didn't repeat any records. I was sooooooo jacked.......thought I had fixed it.....but the next time I ran it it started repeating records again. It makes absolutely no sense to me.

[MMcCarthy]

There is no MoveNext in the Report Open procedure. There is a move next in the detail format through.

Actually there are a few of them. These are the ones I was talking about though.

' If it is an even count -
If oddEven = "Even" Then
   'Divide rateCounter by two
   rateCounter = rateCounter / 2
   'Loop to that number
   For i = 0 To rateCounter
      ' Once we are at that number
      If i = rateCounter Then
         ' Tak that rate - The 1st middle value
         rankRate = rstReport.Fields("RATE").Value
         'MsgBox rankRate
      Else
         rstReport.MoveNext
      End If
   Next i
End If
 
' If it is an odd count -
If oddEven = "Odd" Then
    'Divide rateCounter by two
    rateCounter = rateCounter / 2
    'Strip what is after the decimal point and round to the next number
    tmp = Val(rateCounter)
        If rateCounter - tmp >= 0.5 Then
            rateCounter = tmp + 1
        Else
            rateCounter = tmp
        End If
    'Loop to that number
    For i = 0 To rateCounter
        ' Once we are at that number
        If i = rateCounter Then
            ' Tak that rate - The 1st middle value
            rankRate = rstReport.Fields("RATE").Value
            MsgBox rankRate
        Else
            rstReport.MoveNext
        End If
    Next i
End If
 

[fperri]

Actually there are a few of them. These are the ones I was talking about though.

' If it is an even count -
If oddEven = "Even" Then
   'Divide rateCounter by two
   rateCounter = rateCounter / 2
   'Loop to that number
   For i = 0 To rateCounter
      ' Once we are at that number
      If i = rateCounter Then
         ' Tak that rate - The 1st middle value
         rankRate = rstReport.Fields("RATE").Value
         'MsgBox rankRate
      Else
         rstReport.MoveNext
      End If
   Next i
End If
 
' If it is an odd count -
If oddEven = "Odd" Then
    'Divide rateCounter by two
    rateCounter = rateCounter / 2
    'Strip what is after the decimal point and round to the next number
    tmp = Val(rateCounter)
        If rateCounter - tmp >= 0.5 Then
            rateCounter = tmp + 1
        Else
            rateCounter = tmp
        End If
    'Loop to that number
    For i = 0 To rateCounter
        ' Once we are at that number
        If i = rateCounter Then
            ' Tak that rate - The 1st middle value
            rankRate = rstReport.Fields("RATE").Value
            MsgBox rankRate
        Else
            rstReport.MoveNext
        End If
    Next i
End If
 

I actually figured it out........I'm a retard. Seriously, I am. What it ended up being was that the report is pulling its data from a crosstab query. The table that the crosstab table is using had some of the fields with null and zero values in them - so when the crosstab was created it had repeated rate rows in it because not all the records had the same values in the other fields (the ones that had null or zero values should have had a value in them that the other records all share). So........and I don't completely understand....but I guessing that it was looping through the recordset in the code assigning the values to the fields at the same time - since I assigned the crosstab query to the report's recordsource as well, it was looping through the recordset as well. Somehow, when its looping in the code, it assigns the values properly but reaches the end of the recordset before the report does, that's why it keeps going and repeats the last record assigned until it reaches the end of the recordset.

I figured it out when I finally decided to make a copy of the report, take out the code, and assign the fields to the recordsource and see what came up. Well, the exact same amount of rows - so I opened up the crosstab and saw it.

I feel silly - but thank you though for trying to help me.

~ Franccesca

[MMcCarthy]

No Problem Franccesca.

I'm glad you got it working.