Solved

Filtering subform results based on unbound listbox selections

Posted on 2008-10-31
13
774 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
  • 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
 

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
Backup Your Microsoft Windows Server®

Backup all your Microsoft Windows Server – on-premises, in remote locations, in private and hybrid clouds. Your entire Windows Server will be backed up in one easy step with patented, block-level disk imaging. We achieve RTOs (recovery time objectives) as low as 15 seconds.

 

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

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

This article is a continuation or rather an extension from Cascading Combos (http://www.experts-exchange.com/A_5949.html) and builds on examples developed in detail there. It should be understandable alone, but I recommend reading the previous artic…
Introduction The Visual Basic for Applications (VBA) language is at the heart of every application that you write. It is your key to taking Access beyond the world of wizards into a world where anything is possible. This article introduces you to…
Familiarize people with the process of utilizing SQL Server views from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Microsoft Access…
With Microsoft Access, learn how to specify relationships between tables and set various options on the relationship. Add the tables: Create the relationship: Decide if you’re going to set referential integrity: Decide if you want cascade upda…

705 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

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now