Extremely complex form for Report Criteria - Looking for Ideas (1 Viewer)

[boblarson]

Sorry for the long post, but I had to do it.

I have been working for a long time on this criteria form for a report. The filter code for anything which is on the main report has been easy to implement. The tricky part is that there are fields that need to be able to be used as criteria which exist on any of two subreports as well.

I know how to be able to filter the report based on the items in the subreports (we have a propertyID field which is applicable to both the main report and the subreports, so if I can get the property ID's which match the criteria on the subreports, I will be able to limit at the main report by those property id's which match.

The tricky part comes in that I have 4 distinct subreports which appear on the report. So, what I've done to this point is:

1. If the item is from a subreport, I have a SQL string which I build to pull only those propertyID's which match the criteria for that item and I put it into an array.

2. For each of them I have an array which is built.

3. The hard part I am having deciding on how to do is that I need to check each of the arrays against the others to only pull out the propertyID's which all match, EXCEPT that if one, or more, of the items based on the subreports is NOT used, then don't include it in the matching code as there would not be an array for them anyway and there wouldn't be any propertyID's in there.

4. If I just combine the arrays, that would give me sort of what I want but it would only ADD properties to the main query because it would not limit to only those that matched based on the criteria.

5. Here's the code I started off using which works to get the ID's which match in all three (will need to expand to the fourth as well) arrays. The problem is, that if no criteria is entered for, say TCPrice then none of the other two arrays will have any properties which match and the result is none of them, where there clearly should be those which match between the two that have criteria. I need to figure out a way to only look at the ones which have been used and have created their array, and that is my main stumbling block.

Function GetUniquePIDs() As String
    Dim lngCountEquity As Long
    Dim lngCountTCPrice As Long
    Dim lngCountTCAmount As Long
    Dim strHold As String
    Dim blnFound As Boolean
 
    ' The equity array
    If IncludeEquity Then
        For lngCountEquity = 0 To UBound(garrEquity)
            If IncludeTCPrice Then
                For lngCountTCPrice = 0 To UBound(garrTCPrice)
                    If garrEquity(lngCountEquity) = garrTCPrice(lngCountTCPrice) Then
                        blnFound = True
                    End If
                Next
            End If
            If IncludeTCAmount Then
                For lngCountTCAmount = 0 To UBound(garrTCAmount)
                    If garrEquity(lngCountEquity) = garrTCAmount(lngCountTCAmount) Then
                        blnFound = True
                    End If
                Next
            End If
            If blnFound Then
                If InStr(1, strHold, garrEquity(lngCountEquity), vbTextCompare) = 0 Then
                    strHold = strHold & garrEquity(lngCountEquity) & ","
                End If
            End If
            blnFound = False
        Next
    End If
    ' The TC Price array
    If IncludeTCPrice Then
        For lngCountTCPrice = 0 To UBound(garrTCPrice)
            If IncludeEquity Then
                For lngCountEquity = 0 To UBound(garrEquity)
                    If garrTCPrice(lngCountTCPrice) = garrEquity(lngCountEquity) Then
                        blnFound = True
                    End If
                Next
            End If
            If IncludeTCAmount Then
                For lngCountTCAmount = 0 To UBound(garrTCAmount)
                    If garrTCPrice(lngCountTCPrice) = garrTCAmount(lngCountTCAmount) Then
                        blnFound = True
                    End If
                Next
            End If
            If blnFound Then
                If InStr(1, strHold, garrTCPrice(lngCountTCPrice), vbTextCompare) = 0 Then
                    strHold = strHold & garrTCPrice(lngCountTCPrice) & ","
                End If
            End If
            blnFound = False
        Next
    End If
    ' The TC Amount Array
    If IncludeTCAmount Then
        For lngCountTCAmount = 0 To UBound(garrTCAmount)
            If IncludeEquity Then
                For lngCountEquity = 0 To UBound(garrEquity)
                    If garrTCAmount(lngCountTCAmount) = garrEquity(lngCountEquity) Then
                        blnFound = True
                    End If
                Next
            End If
            If IncludeTCPrice Then
                For lngCountTCPrice = 0 To UBound(garrTCPrice)
                    If garrTCAmount(lngCountTCAmount) = garrTCPrice(lngCountTCPrice) Then
                        blnFound = True
                    End If
                Next
            End If
            If blnFound Then
                If InStr(1, strHold, garrTCAmount(lngCountTCAmount), vbTextCompare) = 0 Then
                    strHold = strHold & garrTCAmount(lngCountTCAmount) & ","
                End If
            End If
            If Right(strHold, 1) = "," Then
                strHold = Left(strHold, Len(strHold) - 1)
            End If
            blnFound = False
        Next
    End If
    Debug.Print strHold
    GetUniquePIDs = strHold
End Function

And just a pic to show what the form looks like (still under construction and I have thought about some formatting changes, and some other changes):

 

[vbaInet]

Sorry Bob, I haven't read your post fully yet because I'm leaving the office in a minute but from a quick here's a suggestion:

* Using two dictionaries, one per subform, create a list of fields that are present in that subform.
* Using another dictionary, create a list of fields that are present in the search form
* For each field used in the criteria, check against your two dictionaries and if it exists include it in the criteria.

I will read it properly tomorrow or if I manage to log in at home later tonight.

 

[boblarson]

Sorry Bob, I haven't read your post fully yet because I'm leaving the office in a minute but from a quick here's a suggestion:

* Using two dictionaries, one per subform, create a list of fields that are present in that subform.
* Using another dictionary, create a list of fields that are present in the search form
* For each field used in the criteria, check against your two dictionaries and if it exists include it in the criteria.

I will read it properly tomorrow or if I manage to log in at home later tonight.

Yeah, I think you'll need to be able to read the entire post thoroughly to see what I need. I already know how to limit the data because I would be using PropertyID for each subreport, but it is how to get only the matching propertyID's between everything and trying to match something that doesn't have any values won't work.

I know it is hard to describe exactly what I have. But hopefully after reading the entire thing (I know it's freakin' long but I don't know that I could have made it shorter).

 

[vbaInet]

Just re-read it and I think I understand what you wrote. Notice I said "I think"

Still going with the dictionary idea, so:

* instead of saving the items into arrays save them into dictionaries.
* Loop through the dictionary with the least number of items, and for each item check if it exists in the other dictionaries.
* If it exist add it to a new dictionary (which you will use as your final collection of items).
* Or if it doesn't exist, delete it from the dictionary you're using in the loop.

Am I following?

 

[boblarson]

Just re-read it and I think I understand what you wrote. Notice I said "I think"

Still going with the dictionary idea, so:

* instead of saving the items into arrays save them into dictionaries.
* Loop through the dictionary with the least number of items, and for each item check if it exists in the other dictionaries.
* If it exist add it to a new dictionary (which you will use as your final collection of items).
* Or if it doesn't exist, delete it from the dictionary you're using in the loop.

I have no clue what you are talking about when you talk about saving them into a dictionary. But from what you've written, the same thing is how I'm doing it with arrays. The only thing stopping me at the moment is trying to figure out how to determine if an array has been instantiated because if it exists, there is data in it. But the sticking point still comes around to that if only one of those criteria which would generate an array, or dictionary as you would have me do, then the entire contents would be used and NOT checked against others because there would not be any matches which would mean that they all would be incorrectly discarded.

Also, here's a sample of my form's code up to this point just to give you an idea of what I've been doing:

Private Sub cmdOK_Click()
    Dim strWhere As String
    Dim strHold As String
    Dim strSQL As String
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim lngRec As Long
    Dim strCheckBoxSelections As String
    Dim strSQLParameter As String
    Dim blnNoOrderBy As Boolean
    Dim strOrderBy As String
    Dim strPropertyIDs As String
    '    Erase garrPIDs
    ReDim garrPIDs(0)
    ' Originator Selections
    If AreThereListSelections(Me.lstOriginator) Then
        strHold = "OrigID In(" & GetListBoxValues(Me.lstOriginator, 1) & ") AND "
        '    Debug.Print strHold
    End If
    ' LT Name Selections
    If AreThereListSelections(Me.lstLTNames) Then
        strHold = strHold & "property_id In(" & GetListBoxValues(Me.lstLTNames, 1) & ") AND "
        '    Debug.Print strHold
    End If
    ' Developer Selections
    If AreThereListSelections(Me.lstDevelopers) Then
        strHold = strHold & "DevID In(" & GetListBoxValues(Me.lstDevelopers, 1) & ") AND "
        '    Debug.Print strHold
    End If
    ' Timing Types Selections
    If AreThereListSelections(Me.lstTimingTypes) Then
        strHold = strHold & "TimingTypeFK In(" & GetListBoxValues(Me.lstTimingTypes, 1) & ") AND "
        '        Debug.Print strHold
    End If
    ' State Selections
    If AreThereListSelections(Me.lstTimingTypes) Then
        strHold = strHold & "TimingTypeFK In(" & GetListBoxValues(Me.lstTimingTypes, 1) & ") AND "
        '        Debug.Print strHold
    End If
 
    ' County Selections
    If AreThereListSelections(Me.lstCounties) Then
        strHold = strHold & "county In(" & GetListBoxValues(Me.lstCounties, 2) & ") AND "
        '        Debug.Print strHold
    End If
 
    ' City Selections
    If AreThereListSelections(Me.lstCities) Then
        strHold = strHold & "Property_City In(" & GetListBoxValues(Me.lstCities, 2) & ") AND "
        '        Debug.Print strHold
    End If
    ' TC Status Selections
    If AreThereListSelections(Me.lstTCSTatus) Then
        strHold = strHold & "TCStatus In(" & GetListBoxValues(Me.lstTCSTatus, 1) & ") AND "
        '        Debug.Print strHold
    End If
    ' Developer Type Selections
    strCheckBoxSelections = chkPipelineBoxSelections(Me, "cmdSelAllDeveloperTypes", 3, Chr(34), "RepeatDeveloperOrNew")
    If strCheckBoxSelections <> vbNullString And Trim(strCheckBoxSelections) <> "RepeatDeveloperOrNew" Then
        strHold = strHold & " " & strCheckBoxSelections & " AND "
    End If
    ' Probability Selections
    strCheckBoxSelections = chkPipelineBoxSelections(Me, "cmdSelAllProbability", 3, Chr(34), "Probability")
    If strCheckBoxSelections <> vbNullString And Trim(strCheckBoxSelections) <> "Probability" Then
        strHold = strHold & " " & strCheckBoxSelections & " AND "
    End If
    '    Debug.Print strHold
 
    ' Key Transaction Selections
    strCheckBoxSelections = chkPipelineBoxSelections(Me, "cmdSelAllKeyTrans", 3, vbNullString, "KeyTrans")
    If strCheckBoxSelections <> vbNullString And Trim(strCheckBoxSelections) <> "KeyTrans" Then
        strHold = strHold & " " & strCheckBoxSelections & " AND "
    End If
    '    Debug.Print strHold
 
    ' Property Type Selections
    strCheckBoxSelections = chkPipelineBoxSelections(Me, "cmdSelAllPropTypes", 3, Chr(34), "Property_Type")
    If strCheckBoxSelections <> vbNullString And Trim(strCheckBoxSelections) <> "Property_Type" Then
        strHold = strHold & " " & strCheckBoxSelections & " AND "
    End If
    '    Debug.Print strHold
    ' Tenant Mix Selections
    strCheckBoxSelections = chkPipelineBoxSelections(Me, "cmdSelAllTenantMix", 3, Chr(34), "Tenant_Mix")
    If strCheckBoxSelections <> vbNullString And Trim(strCheckBoxSelections) <> "Tenant_Mix" Then
        strHold = strHold & " " & strCheckBoxSelections & " AND "
    End If
    ' Market Type Selections
    strCheckBoxSelections = chkPipelineBoxSelections(Me, "cmdSelAllMktTypes", 3, Chr(34), "Market_Type")
    If strCheckBoxSelections <> vbNullString And Trim(strCheckBoxSelections) <> "Market_Type" Then
        strHold = strHold & " " & strCheckBoxSelections & " AND "
    End If
 
    Debug.Print strHold
 
    '    Debug.Print strHold
    ' Tax Credit Type Selections ############## SUBREPORT SUBREPORT #############
    '    strCheckBoxSelections = chkPipelineBoxSelections(Me, "cmdTaxCreditTypes", 3, Chr(34))
    '    If strCheckBoxSelections <> vbNullString Then
    '        strHold = strHold & "Tenant_Mix In(" & strCheckBoxSelections & ") AND "
    '    End If
    '    Debug.Print strHold
    ' Tax Credit Rate Selections
    strOrderBy = "ORDER BY PropertyFK"
    ' 4%
    If Me.chkTaxCreditRate4Pct Then
        strSQL = "" & _
                 "SELECT dbo_ProfilePortfolio.PortfolioID, dbo_XrefPortfolioProps.PropertyFK as PID, dbo_ProfilePortfolio.PortfolioName, dbo_XrefPortfolioProps.AdmitDate, " & _
                 "dbo_XrefPortfolioProps.ExitDate, sbqryTCStatus.TCRate " & _
                 "FROM (dbo_ProfilePortfolio INNER JOIN dbo_XrefPortfolioProps ON dbo_ProfilePortfolio.PortfolioID = dbo_XrefPortfolioProps.PortfolioFK) " & _
                 "LEFT JOIN sbqryTCStatus ON dbo_XrefPortfolioProps.PropertyFK = sbqryTCStatus.PropertyID " & _
                 "WHERE " & IIf(IsNull([Forms]![frmReports]![cboUpperTier]), vbNullString, "dbo_ProfilePortfolio.PortfolioID =" & [Forms]![frmReports]![cboUpperTier] & " AND ") & " " & _
               " (dbo_XrefPortfolioProps.AdmitDate Is Not Null And dbo_XrefPortfolioProps.AdmitDate <=#" & Date & "#) AND (dbo_XrefPortfolioProps.ExitDate Is Null " & _
                 "Or dbo_XrefPortfolioProps.ExitDate >=#" & Date & "#) AND [TCRate]='4%' "
    End If
 
    ' 9%
    If Me.chkTaxCreditRate9Pct Then
        If strSQL <> vbNullString Then
            strSQL = strSQL & strOrderBy
            strSQL = strSQL & " UNION "
            blnNoOrderBy = True
        End If
        strSQL = strSQL & "" & _
                 "SELECT dbo_ProfilePortfolio.PortfolioID, dbo_XrefPortfolioProps.PropertyFK as PID, dbo_ProfilePortfolio.PortfolioName, dbo_XrefPortfolioProps.AdmitDate, " & _
                 "dbo_XrefPortfolioProps.ExitDate, sbqryTCStatus.TCRate " & _
                 "FROM (dbo_ProfilePortfolio INNER JOIN dbo_XrefPortfolioProps ON dbo_ProfilePortfolio.PortfolioID = dbo_XrefPortfolioProps.PortfolioFK) " & _
                 "LEFT JOIN sbqryTCStatus ON dbo_XrefPortfolioProps.PropertyFK = sbqryTCStatus.PropertyID " & _
                 "WHERE " & IIf(IsNull([Forms]![frmReports]![cboUpperTier]), vbNullString, "dbo_ProfilePortfolio.PortfolioID =" & [Forms]![frmReports]![cboUpperTier] & " AND ") & " " & _
               " (dbo_XrefPortfolioProps.AdmitDate Is Not Null And dbo_XrefPortfolioProps.AdmitDate <=#" & Date & "#) AND (dbo_XrefPortfolioProps.ExitDate Is Null " & _
                 "Or dbo_XrefPortfolioProps.ExitDate >=#" & Date & "#) AND [TCRate]='9%' "
    End If
    '' Historic
    If Me.chkTaxCreditRateHistoric Then
        If strSQL <> vbNullString Then
            If blnNoOrderBy Then
                strSQL = strSQL & " UNION "
            Else
                strSQL = strSQL & strOrderBy
                strSQL = strSQL & " UNION "
            End If
        End If
        strSQL = strSQL & "" & _
                 "SELECT dbo_ProfilePortfolio.PortfolioID, dbo_XrefPortfolioProps.PropertyFK as PID, dbo_ProfilePortfolio.PortfolioName, dbo_XrefPortfolioProps.AdmitDate, " & _
                 "dbo_XrefPortfolioProps.ExitDate, sbqryTCStatus.TCRate " & _
                 "FROM (dbo_ProfilePortfolio INNER JOIN dbo_XrefPortfolioProps ON dbo_ProfilePortfolio.PortfolioID = dbo_XrefPortfolioProps.PortfolioFK) " & _
                 "LEFT JOIN sbqryTCStatus ON dbo_XrefPortfolioProps.PropertyFK = sbqryTCStatus.PropertyID " & _
                 "WHERE " & IIf(IsNull([Forms]![frmReports]![cboUpperTier]), vbNullString, "dbo_ProfilePortfolio.PortfolioID =" & [Forms]![frmReports]![cboUpperTier] & " AND ") & " " & _
               " (dbo_XrefPortfolioProps.AdmitDate Is Not Null And dbo_XrefPortfolioProps.AdmitDate <=#" & Date & "#) AND (dbo_XrefPortfolioProps.ExitDate Is Null " & _
                 "Or dbo_XrefPortfolioProps.ExitDate >=#" & Date & "#) AND [TCRate]='Historic' "
    End If
    If strSQL <> vbNullString Then
        If InStr(1, strSQL, "ORDER BY", vbTextCompare) = 0 Then
            strSQL = strSQL & strOrderBy
        End If
    End If
    'Debug.Print strSQL
    'Debug.Print GetPropertyIDList(strSQL)
    ' Equity Amount
    If Len(Me.txtEquityFrom & vbNullString) > 0 And Len(Me.txtEquityTo & vbNullString) > 0 Then
        strSQL = "SELECT mktblPipeCriteria.property_id As PID, dbo_wselCapitalTotals.OrigCapPNC, sbqryPipePNCDebt.AltName, sbqryPipePNCDebt.Amount, sbqryPipePNCDebtPreDevLoan.PreDevAmount AS PreDevAmt, sbqryPipePNCDebt.DebtInstTypeName " & _
                 "FROM ((mktblPipeCriteria LEFT JOIN dbo_wselCapitalTotals ON mktblPipeCriteria.property_id = dbo_wselCapitalTotals.Property_ID) LEFT JOIN sbqryPipePNCDebt ON mktblPipeCriteria.property_id = sbqryPipePNCDebt.PropertyFK) LEFT JOIN sbqryPipePNCDebtPreDevLoan ON mktblPipeCriteria.property_id = sbqryPipePNCDebtPreDevLoan.PropertyFK " & _
                 "WHERE (((dbo_wselCapitalTotals.OrigCapPNC) Between " & Me.txtEquityFrom & " AND " & Me.txtEquityTo & ")) " & _
                 "GROUP BY mktblPipeCriteria.property_id, dbo_wselCapitalTotals.OrigCapPNC, sbqryPipePNCDebt.AltName, sbqryPipePNCDebt.Amount, sbqryPipePNCDebtPreDevLoan.PreDevAmount, sbqryPipePNCDebt.DebtInstTypeName " & _
                 "ORDER BY mktblPipeCriteria.property_id;"
        'Debug.Print GetPropertyIDList(strSQL)
        GetPropertyIDList strSQL
        CopyArray garrEquity, garrPIDs, True
 
    End If
    ' Units Between
    If Len(Me.txtUnitsFrom & vbNullString) > 0 And Len(Me.txtUnitsTo & vbNullString) > 0 Then
        strHold = strHold & " [Units] Between " & Me.txtUnitsFrom & " And " & Me.txtUnitsTo & " AND "
    End If
    ' Tax Credit Price
    If Len(Me.txtTCPriceFrom & vbNullString) > 0 And Len(Me.txtTCPriceTo & vbNullString) > 0 Then
        If Len(Forms!frmReports.cboUpperTier & vbNullString) > 0 Then
            strSQL = "SELECT dbo_TransLTTaxCredits.PropertyFK AS PID, dbo_TransLTTaxCredits.ForecastPrice, dbo_XrefPortfolioProps.PortfolioFK " & _
                     "FROM dbo_TransLTTaxCredits INNER JOIN dbo_XrefPortfolioProps ON dbo_TransLTTaxCredits.PropertyFK = dbo_XrefPortfolioProps.PropertyFK " & _
                     "WHERE (((dbo_TransLTTaxCredits.ForecastPrice) Between " & [Forms]![frmPipelineCriteriaAndSort]![txtTCPriceFrom] & _
                   " And " & [Forms]![frmPipelineCriteriaAndSort]![txtTCPriceTo] & ") AND ((dbo_XrefPortfolioProps.PortfolioFK)=" & [Forms]![frmReports]![cboUpperTier] & _
                     ") AND ((dbo_XrefPortfolioProps.AdmitDate)<=#" & Date & "#) AND ((dbo_XrefPortfolioProps.ExitDate)>#" & Date & "# Or (dbo_XrefPortfolioProps.ExitDate) Is Null));"
 
        Else
            strSQL = "SELECT dbo_TransLTTaxCredits.PropertyFK As PID, dbo_TransLTTaxCredits.ForecastPrice " & _
                     "FROM dbo_TransLTTaxCredits " & _
                     "WHERE (((dbo_TransLTTaxCredits.ForecastPrice) Between " & [Forms]![frmPipelineCriteriaAndSort]![txtTCPriceFrom] & " And " & [Forms]![frmPipelineCriteriaAndSort]![txtTCPriceTo] & "));"
        End If
        LogValues conLogPath, "TC PRICE"
        Debug.Print GetPropertyIDList(strSQL)
        '        GetPropertyIDList strSQL
        LogValues conLogPath, "***********************"
        CopyArray garrTCPrice, garrPIDs, True
    End If
    ' Tax Credit Amount
    If Len(Me.txtTCAmtFrom & vbNullString) > 0 And Len(Me.txtTCAmtTo & vbNullString) > 0 Then
        strSQL = "SELECT dbo_TransLTTaxCredits.PropertyFK As PID, dbo_TransLTTaxCredits.ActualStable " & _
                 "FROM dbo_TransLTTaxCredits " & _
                 "WHERE (((dbo_TransLTTaxCredits.ActualStable) Between " & [Forms]![frmPipelineCriteriaAndSort]![txtTCAmtFrom] & " And " & [Forms]![frmPipelineCriteriaAndSort]![txtTCAmtTo] & "))" & _
                 "ORDER BY dbo_TransLTTaxCredits.PropertyFK;"
        LogValues conLogPath, "TC AMT"
        '    Debug.Print GetPropertyIDList(strSQL)
        GetPropertyIDList strSQL
        LogValues conLogPath, "************************"
        CopyArray garrTCAmount, garrPIDs, True
    End If
    If Len(Forms!frmReports.cboUpperTier & vbNullString) > 0 Then
        strPropertyIDs = RetAppPIDs(Forms!frmReports.cboUpperTier, GetUniquePIDs)
    Else
        strPropertyIDs = GetUniquePIDs
    End If
    If strPropertyIDs <> vbNullString Then
        strHold = strHold & "[property_id]In(" & strPropertyIDs & ")"
    End If
    ' Open the report
    If Right(strHold, 5) = " AND " Then
        strHold = Left(strHold, Len(strHold) - 5)
    End If
    strWhere = strHold
    'Debug.Print "UBound - " & UBound(garrPIDs)
    Debug.Print strWhere
    Debug.Print "Selected " & numPropIDitems
    '    DoCmd.OpenReport "rptPipeline", acViewPreview, , strWhere
End Sub

 

[vbaInet]

How did you get on with this Bob? I was going through my messages and remembered I hadn't replied back.

 

[boblarson]

I ended up having to go a different route with this. Still not done as I'm working on the sorting/grouping part, but I had gotten it to work to get only the property id's which matched all criteria, including the subreport stuff, but it was just way too slow. So, if they select any subreport criteria, the property id's for those will just basically be "additive" where the main report criteria will return what it returns regardless of what gets selected for the subreport criteria. If they choose only subreport criteria, then it will limit by that properly.

 

[vbaInet]

Hmmm... I see. Any chance of uploading a very stripped down version of what you did? I'm still struggling to get the full picture but when I see it in action I will.

 

[boblarson]

Hmmm... I see. Any chance of uploading a very stripped down version of what you did? I'm still struggling to get the full picture but when I see it in action I will.

Unfortunately I don't see how that would be possible (it would take a lot of work just to be able to get it to a point where it would be usable). The majority of the data is in SQL Server and we have 5 other Access backends which connect to it as well. I could possibly get a copy of the frontend up but it would be essentially useless as you would have nothing to connect to. But I would have to post it to my own website as it is a large frontened (35Mb) and I can't use flash drives here to take a copy home to post as they have locked those down.

 

[vbaInet]

Alright. I'll try with just the code. Can you upload that?