Solved

Filtering subform results based on unbound listbox selections

Posted on 2008-10-31
13
780 Views
Last Modified: 2012-05-05
There's other similar questions here but don't seem to be either working or exactly what my issue is.

I have multiple unbound (cascading) listboxes on the mainform, and I would like the subform to filter it's results based on the selections in the listboxes.  For example:

Main form:
-lst1 properties = tblAPK; tblADescription (only shows description)
-lst2 properties = tblBPK; tblBDescription (only shows descrition)
I'm not sure if it makes a difference but the lst2 display is filtered by what's selected in lst1.

Subform properties:  Details; Dates; Names; tblADesc; tblBPK

So the results on the subform would be filtererd when lst1 was selected to only tblADesc, and further filterd when lst2 was selected to only tblB selction.

Right now the only real "code" I have to speak of is requerying the cascasing lists:

Private Sub lstA_AfterUpdate()
Me.lstB.Requery
End Sub

Thanks
0
Comment
Question by:Matt330
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 8
  • 5
13 Comments
 
LVL 7

Accepted Solution

by:
UniqueData earned 500 total points
ID: 22853886
what about having a function in your main form.  Then after update of the list boxes you call the function, which will assign a recordsource to the subform.

Function FilterSubform()
dim strSQL as string
dim strWhere as string, strDelim as string
   
   strDelim = "":strwhere = ""
   If nz(lst1,0) > 0 then
          strWhere = "tblAPK = " & lst1
          strDelim = " And "
   end if

   If nz(lst2,0) > 0 then
          strWhere = strWhere & strdelim & "tblBPK = " & lst2
   end if

   if strwhere <> "" then strwhere = " Where " & strwhere
   strsql = "Select * From qry" & strwhere
   me!subform.form.RecordSource = strsql

End Function
0
 

Author Comment

by:Matt330
ID: 22861917
Thanks Unique - and I'm sorry for the delayed response.  I've been playing with that suggestion and I'm not having any luck.  this is what I have in the main forms "on current" event (is that where it should be?)  I actually just focused on one list box filter to make it easier.

Function FilterSubform()
dim strSQL as string
dim strWhere as string, strDelim as string
   
   strDelim = "":strwhere = ""
   If nz(lst1,0) > 0 then
          strWhere = "tblA.PK = " & lstA
          strDelim = " And "
   end if

   if strwhere <> "" then strwhere = " Where " & strwhere
   strsql = "Select * From qry" & strwhere
   me!subfrmtblA.frmMainFrm.RecordSource = strsql

End Function

couple questions.
-shold this be in the on current Event in the main form?
-you mention calling the function in the after update of the list box?  How do I do that?
-If I already have an after update event in the list box, how would I add the second one?  within the same Private sub (like immediately after the requery line, or a whole new Private subAfter update?  I'm new at this if you can't tell.

Private Sub lsttblA_AfterUpdate()
Me.lsttblA.Requery
End Sub
0
 
LVL 7

Assisted Solution

by:UniqueData
UniqueData earned 500 total points
ID: 22877988
I guess it wouldn't hurt putting it on Current, but mostly on the AfterUpdate of the list box.

Also, not sure why you are requerying the same control after update.  Does the contents of lsttblA change?  I think you just need:

Private Sub lsttblA_AfterUpdate()
   Call FilterSubform()
End Sub

However, I forgot one thing.... in the Function FilterSubform(), you may need to add a line.  
So after:
     me!subfrmtblA.frmMainFrm.RecordSource = strsql
add:
     me!subfrmtblA.frmMainFrm.Requery
0
Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

 

Author Comment

by:Matt330
ID: 22880301
I sort of gave up on that method after awhile, but I may try it as it seems more simplistic than what I found (I actually have 5 listboxes that would filter 3 cascading, and the other two cascading together. .  I used this code from a sample DB I found online and even though it used two multiselect listboxes with option groups and text boxes to filter.

It's ridiculously long but too close to working to give up now, thanks unique - I will probably come back and try your solution before closing this question:


Private Function RequerySubform()
On Error GoTo ProcError
 
Dim strSELECT As String
Dim strWHERE As String
Dim strOrderBy As String
Dim strFullSQL As String
Dim varSuppliers As Variant
Dim varCategories As Variant
Dim varTextboxes As Variant
Dim strFrame As String
 
strSELECT = _
 "SELECT ProductID, ProductName, CompanyName AS Supplier, " _
 & "CategoryName As Category, UnitPrice, ReorderLevel, Discontinued " _
 & "FROM Categories " _
 & "RIGHT JOIN (Suppliers RIGHT JOIN Products " _
 & "ON Suppliers.SupplierID = Products.SupplierID) " _
 & "ON Categories.CategoryID = Products.CategoryID "
 
strOrderBy = " ORDER BY ProductName, CompanyName;"
 
'-- If AutoRequery is set to True, or the Requery button was pressed,
'-- then re-create the Where clause for the recordsource of the subform
 
'-- IMPORTANT NOTE: Do not attempt to set a break point on the next line of code, or
'-- to step through this line of code using the F8 key. You will receive Error 2474 if you
'-- attempt to do this.
 
    If Me.fraAutoRequery Or Screen.ActiveControl.Name = "cmdRequery" Then
 
        '-- Store all the criteria for the Where statement into variables.
        varSuppliers = IncludeSuppliers
        varCategories = IncludeCategories
        varTextboxes = IncludeTextboxes
        strFrame = IncludeStatus
 
        strWHERE = "WHERE " & (varSuppliers + " AND ") & (varCategories + " AND ") _
                    & (varTextboxes) & strFrame
        
       ' Debug.Print strWHERE
    
       '-- Trim off trailing " AND "
       If Mid$(strWHERE, Len(strWHERE) - 4, Len(strWHERE)) = " AND " Then
          strWHERE = Left$(strWHERE, Len(strWHERE) - 5)
       End If
 
       '-- If no criteria was chosen, make it so the subform will be blank.
       If strWHERE = "WHERE " Then
           strWHERE = "WHERE False "
       End If
       
       '-- Create the new SQL String and Store it to the Recordsource.
       strFullSQL = strSELECT & strWHERE & strOrderBy
    
       'Debug.Print strFullSQL
       
       Me.QBFSubform.Form.RecordSource = strFullSQL
    
       '-- Set the requery button to black.
       Me.cmdRequery.ForeColor = 0
       
    Else
       '-- Set the requery button to red.
       Me.cmdRequery.ForeColor = 255
    End If
 
   'Me.txtHidden.SetFocus
 
ExitProc:
   Exit Function
ProcError:
   MsgBox "Error " & Err.Number & ": " & Err.Description, _
          vbCritical, "Error in RequerySubform Function..."
   Resume ExitProc
   Resume
End Function
 
Private Function IncludeSuppliers() As Variant
On Error GoTo ProcError
 
Dim varCategory As Variant
Dim strTempInitial As String
Dim strTemp As String
 
' Set strTempInitial equal to "[TableName].[FieldName]"
' plus the SQL "IN" keyword + the opening parenthesis.
    strTempInitial = "[Products].[SupplierID] In ("
    strTemp = strTempInitial
 
' Process all items selected in lboSuppliers
   For Each varCategory In Me.lboSuppliers.ItemsSelected()
     strTemp = strTemp & Me.lboSuppliers.ItemData(varCategory) & ", "
     'Debug.Print "strTemp = " & strTemp
   Next varCategory
   
   If strTemp <> strTempInitial = True Then
      IncludeSuppliers = FinishINClause(strTemp)
   Else
      IncludeSuppliers = Null
   End If
   
   'Debug.Print "IncludeSuppliers = " & IncludeSuppliers
 
ExitProc:
   Exit Function
ProcError:
   MsgBox "Error " & Err.Number & ": " & Err.Description, _
           vbCritical, "Error in IncludeSuppliers Function..."
   Resume ExitProc
End Function
 
Private Function IncludeCategories() As Variant
On Error GoTo ProcError
 
Dim varCategory As Variant
Dim strTempInitial As String
Dim strTemp As String
 
' Set strTempInitial equal to "[TableName].[FieldName]"
' plus the SQL "IN" keyword + the opening parenthesis.
    strTempInitial = "[Categories].[CategoryID] In ("
    strTemp = strTempInitial
 
' Process all items selected in lboSuppliers
   For Each varCategory In Me.lboCategories.ItemsSelected()
        strTemp = strTemp & Me.lboCategories.ItemData(varCategory) & ", "
        'Debug.Print "strTemp = " & strTemp
   Next varCategory
   
   If strTemp <> strTempInitial = True Then
        IncludeCategories = FinishINClause(strTemp)
   Else
        IncludeCategories = Null
   End If
   
'Debug.Print "IncludeCategories = " & IncludeCategories
 
ExitProc:
   Exit Function
ProcError:
   MsgBox "Error " & Err.Number & ": " & Err.Description, _
               vbCritical, "Error in IncludeCategories Function..."
   Resume ExitProc
End Function
 
Private Function FinishINClause(strTemp As String) As String
On Error GoTo ProcError
 
' Strip off trailing comma and add ")"
   FinishINClause = Left$(strTemp, Len(strTemp) - 2) & ")"
   
ExitProc:
   Exit Function
ProcError:
   MsgBox "Error " & Err.Number & ": " & Err.Description, _
           vbCritical, "Error in FinishINClause Function..."
   Resume ExitProc
End Function
 
Private Function IncludeTextboxes() As Variant
On Error GoTo ProcError
 
'Examine txtProductName text box first:
   If Not IsNull(Me.txtProductName) Then
         IncludeTextboxes = "[ProductName] Like " & Chr(34) & Me.txtProductName _
                        & "*" & Chr(34) & " AND " '<--Adds trailing wildcard"
   End If
 
'Examine entries in Unit Price text boxes next:
   If Not IsNull(Me.txtUnitPriceLow) Then   'UnitPrice Field is Number (Currency)
         IncludeTextboxes = IncludeTextboxes & "[UnitPrice] >= " & Me.txtUnitPriceLow & " AND "
   End If
 
   If Not IsNull(Me.txtUnitPriceHigh) Then
         IncludeTextboxes = IncludeTextboxes & "[UnitPrice] <= " & Me.txtUnitPriceHigh & " AND "
   End If
 
'Examine entries in Reorder Level text boxes next:
   If Not IsNull(Me.txtReorderLevelLow) Then   'ReorderLevel Field is Numeric
         IncludeTextboxes = IncludeTextboxes & "[ReorderLevel] >= " & Me.txtReorderLevelLow & " AND "
   End If
 
   If Not IsNull(Me.txtReorderLevelHigh) Then
         IncludeTextboxes = IncludeTextboxes & "[ReorderLevel] <= " & Me.txtReorderLevelHigh & " AND "
   End If
 
'Set to Null if empty...
   If IsEmpty(IncludeTextboxes) Then
      IncludeTextboxes = Null
   End If
 
ExitProc:
   Exit Function
ProcError:
   MsgBox "Error " & Err.Number & ": " & Err.Description, _
           vbCritical, "Error in IncludeTextboxes event procedure..."
   Resume ExitProc
   Resume
End Function
 
Private Function IncludeStatus() As String
 
   If (Me.fraProductStatus) <= 0 Then   'YN Field is numeric (integer)
      IncludeStatus = "[Discontinued] = " & Me.fraProductStatus & " AND "
   Else
      IncludeStatus = "[Discontinued] <=0 AND "
      'IncludeStatus = "[Discontinued] < 1 AND "
   End If
 
ExitProc:
   Exit Function
ProcError:
   MsgBox "Error " & Err.Number & ": " & Err.Description, _
           vbCritical, "Error in IncludeStatus procedure..."
   Resume ExitProc
End Function
 
Private Sub fraAutoRequery_AfterUpdate()
On Error GoTo ProcError
 
   If Me.fraAutoRequery = -1 Then
      RequerySubform
   End If
 
'Save user's last choice as the default
   CurrentDb.Execute "UPDATE tblFEVersion SET blnAutoRequery = " _
                    & Me.fraAutoRequery, dbFailOnError
 
ExitProc:
   Exit Sub
ProcError:
   MsgBox "Error " & Err.Number & ": " & Err.Description, _
           vbCritical, "Error in fraAutoRequery_AfterUpdate event procedure..."
   Resume ExitProc
End Sub
 
Private Sub cmdReset_Click()
On Error GoTo ProcError
 
   Dim intCurrCat As Integer
   
   '-- First, clear the multi-select list boxes.
   For intCurrCat = 0 To Me.lboSuppliers.ListCount - 1
       Me.lboSuppliers.Selected(intCurrCat) = False
   Next intCurrCat
  
   For intCurrCat = 0 To Me.lboCategories.ListCount - 1
       Me.lboCategories.Selected(intCurrCat) = False
   Next intCurrCat
 
   '-- Next, clear all text boxes
   Me.txtProductName = Null
   Me.txtUnitPriceLow = Null
   Me.txtUnitPriceHigh = Null
   Me.txtReorderLevelLow = Null
   Me.txtReorderLevelHigh = Null
   
   '-- Set fraProductStatus to Active Records
   Me.fraProductStatus = 0
 
   '-- Clear the subform of any results
   Me.QBFSubform.Form.RecordSource = "SELECT * FROM qryQBF WHERE FALSE"
 
ExitProc:
     Exit Sub
ProcError:
     MsgBox "Error " & Err.Number & ": " & Err.Description, _
             vbCritical, "Error in procedure cmdClear_Click..."
     Resume ExitProc
End Sub
 
Private Sub cmdClose_Click()
On Error GoTo ProcError
 
   DoCmd.Close acForm, Me.Name
 
ExitProc:
   Exit Sub
ProcError:
   MsgBox "Error " & Err.Number & ": " & Err.Description, _
           vbCritical, "Error in procedure cmdClose_Click..."
   Resume ExitProc
End Sub

Open in new window

0
 
LVL 7

Expert Comment

by:UniqueData
ID: 22886840
actually, the basics are pretty much the same.  Create the Where statement then change the RecordSource for the subform to the created Where Statement.

Part of the code you found handles multiple select list boxes so if your list boxes are single-select, it is a bit overkill.
0
 

Author Comment

by:Matt330
ID: 22886944
You're absolutely right, I think I've figured out that not only was it overkill, it's doesn't work very smooth because my list boxes aren't meant to be multiple select, and for some reason the filtering / clearing the filters isn't very "natural" as single select.  I'm writing those 12 hours off as a loss, but I think I learned some stuff because the code you gave me I can sort of read through and understand now, so maybe I'll be more successful at implementing it the second time around.

I'll try again hopefully in the next couple of hours or later tonight.  Thanks again Unique.
0
 

Author Comment

by:Matt330
ID: 22890209
This line:
     me!subfrmtblA.frmMainFrm.RecordSource = strsql

results in ther error message "Can't find field "subfrmtblA"
0
 
LVL 7

Expert Comment

by:UniqueData
ID: 22899503
Replace frmMainFrm with Form.  So it will be:

 me!subfrmtblA.Form.RecordSource = strsql

That says, go to the control called subfrmtblA and go to the form it contains, and set the Recordsource to strSQL
0
 

Author Comment

by:Matt330
ID: 22899668
It still results in the same error "CAn't find field "subfrmRegDocUpdate" referred to in your expression.  I'm going to stop being cryptic because I think that's confusing me, and there's no real reason to be I suppose.  Here's the full Function I typed up:


Function FilterSubform()
Dim strSQL As String
Dim strWhere As String, strDelim As String
   
   strDelim = "": strWhere = ""
   If Nz(lboStudies, 0) > 0 Then
          strWhere = "tblRegDocs.StudyNum = " & lboStudies
          strDelim = " And "
   End If
 
   If strWhere <> "" Then strWhere = " Where " & strWhere
   strSQL = "Select * From qry" & strWhere
   Me!subfrmRegDocUpdate.Form.RecordSource = strSQL
   Me!subfrmRegDocUpdate.Form.Requery
 
End Function

Open in new window

0
 

Author Closing Comment

by:Matt330
ID: 31512171
I think the answer was probably right but there's probably some external factors that I have to mess with to get it working.
0
 

Author Comment

by:Matt330
ID: 22913426
Thanks Unique - I actually got the really long version working the way It should.  Initially my problem was trying to call two Functions (one to populate the slave list boxes, and one two filter the subform).  I put the filter subform as a double-click event and it works fine.

I'm still going to leisurly try to get yours to work.  The error I desribed above about "Cant find field ..." was fixed by deleting the subform, and dragging and dropping it back onto the form, rather than creating it on the form and just typing the subform name in the white box.  

Anyway thanks for your patience, like I said I'm going to keep playing with your suggestion to see if I can get it to work, but can you tell me if the syntax for this is correct (I added my other 3 listboxes to ):


Function FilterSubform()
Dim strSQL As String
Dim strWhere As String, strDelim As String
   
   strDelim = "": strWhere = ""
   If Nz(lboStudies, 0) > 0 Then
          strWhere = "tblRegDocs.StudyNum = " & lboStudies
          strDelim = " And "
   End If
   
   If Nz(lboSites, 0) > 0 Then
        strWhere = strWhere & strDelim & "tblSiteList.SiteID = " & lboSites
   End If
   
   If Nz(cboTmfSections, 0) > 0 Then
        strWhere = strWhere & strDelim & "tblMasterSec.MasterID = " & cboTmfSections
    End If
    
    If Nz(lboSites, 0) > 0 Then
        strWhere = strWhere & strDelim & "tblDocType.DocID = " & lboDoctype
    End If
    
    If Nz(lboDocSubType, 0) > 0 Then
        strWhere = strWhere & strDelim & "tblDocSubType.DocSubID = " & lboDocSubType
    End If
    
   If strWhere <> "" Then strWhere = " Where " & strWhere
   strSQL = "Select * From qry" & strWhere
   Me!subfrmRegDocUpdate.Form.RecordSource = strSQL
   Me!subfrmRegDocUpdate.Form.Requery
 
End Function

Open in new window

0
 
LVL 7

Expert Comment

by:UniqueData
ID: 22913543
you need to add:  strDelim = " And "
after each place you have 'strWhere = strWhere & ....'

What this does is if the next If is true, there will be an 'And' ready to go between them
0
 

Author Comment

by:Matt330
ID: 22913577
Great - thanks again!
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Overview: This article:       (a) explains one principle method to cross-reference invoice items in Quickbooks®       (b) explores the reasons one might need to cross-reference invoice items       (c) provides a sample process for creating a M…
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.
In Microsoft Access, learn the trick to repeating sub-report headings at the top of each page. The problem with sub-reports and headings: Add a dummy group to the sub report using the expression =1: Set the “Repeat Section” property of the dummy…

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question