CODEWITHSUNDEEP
vbaformsms-accesslistboxlistbox-control
Sebastian
Sebastian

Reputation: 13

Have a List box that Filters on items within my subform that is a query

I have a list box that has three different categories to choose from on the form. I have vba code that is working that allows me to select more than one item in the list box which is fine. But the items I am selecting I am having troubles to get the results that I need.

For an Example; The three categories within the list box are not in the query with the actual category names. One Category I have is called "Picking" okay, I want to select "picking" and then when the button is clicked I want it to pull all Items within the query field "Item Number" that equals '0801' which represents the Category "Picking".

Note the code behind the button is a simple "On Click" Event Procedure

**The List box I am Having troubles with is called (StrAccounts)

**Picking which is the same thing as Acct in the query that I am trying filter on in in tbUpload

**I want the "Picking" Category in the List box to filter on Acct in the query where Acct = '0801'

**Placed_Orders which the Second category name within my ListBox and it is the same field in the query above "tbUpload", Acct, except I want this Placed_Orders to get all Acct in ('1108', '1114', '1117', '1113', '1110')

**Whatever Acct in the query tbUpload that doesn't contain the following numbers already mention above is the third category in my list box which is "Not_Placed"

**So whenever Not_Placed in the list box is clicked and the search button is selected I want Accts in the query to pull, Accts <> '0801','1108','1114','1117','1113','1110'

Private Sub cmdSearch_Click()
Dim Varitem As Variant
Dim StrDEPT_OBS As String
Dim StrStatus As String
Dim StrACCT As String
Dim strSQL As String
Dim StrAccounts As String

'get selections from DEPT_OBS multiselect listbox
For Each Varitem In Me!List_Dept_OBS.ItemsSelected
StrDEPT_OBS = StrDEPT_OBS & ",'" & Me!List_Dept_OBS.ItemData(Varitem) & "'"
Next

'get selections from Status multiselect listbox
For Each Varitem In Me!List_Status.ItemsSelected
StrStatus = StrStatus & ",'" & Me!List_Status.ItemData(Varitem) & "'"
Next

'get selections from Accts multiselect listbox
 For Each Varitem In Me!List_ACCTs.ItemsSelected
 StrStatus = StrAccounts & ",'" & Me!List_ACCTs.ItemData(Varitem) & "'"
 Next



 If Len(StrDEPT_OBS) > 0 Then
 StrDEPT_OBS = Right(StrDEPT_OBS, Len(StrDEPT_OBS) - 1)
 Else: MsgBox "You must enter an OBS"

 Exit Sub
 End If

 If Len(StrStatus) > 0 Then
 StrStatus = Right(StrStatus, Len(StrStatus) - 1)
 End If

 If Len(StrAccounts) > 0 Then
 StrAccounts = Right(StrAccounts, Len(StrAccounts) - 1)
  End If



  strSQL = " SELECT * FROM tbUpload WHERE "
  strSQL = strSQL & "tbUpload.DEPT_ID IN (" & StrDEPT_OBS & ") AND "
    If Len(StrStatus) = 0 Then
        strSQL = strSQL & "tbUpload.DEPT_ID IN (" & StrDEPT_OBS & ") "

    Else
        strSQL = strSQL & "tbUpload.OPR_STAT_ID IN (" & StrStatus & ") "
   End If



    If Len(StrAccounts) = 0 And StrAccounts = "Picking" Then
        strSQL = strSQL & "tbUpload.ACCT like (" & [0801] & ")"

    Else
    End If

    If Len(StrAccounts) = 0 And StrAccounts = "Placed_Orders" Then
     strSQL = strSQL & "tbUpload.ACCT IN (" & [1108] & [1114] & [1117] & [1113] & [1110] & ") "

    Else
        strSQL = strSQL & "tbUpload.ACCT <> (" & [0801] & [1108] & [1114] & [1117] & [1113] & [1110] & ") " "Not_Placed"
End If




DoCmd.SetWarnings False
''DoCmd.OpenQuery ("UPLOAD")
 Me![tbUpload subform].Form.RecordSource = strSQL

 End Sub









If Len(StrAccounts) > 0 Then
'' StrAccounts = Right(StrAccounts, Len(StrAccounts) - 1)
StrAccounts = StrAccounts & ",'" & Me!List_ACCTs.ItemData(Varitem) & "'"
End If


strSQL = " SELECT * FROM tbUpload WHERE "
strSQL = strSQL & "tbUpload.DEPT_ID IN (" & StrDEPT_OBS & ") AND "
    If Len(StrStatus) = 0 Then
        strSQL = strSQL & "tbUpload.DEPT_ID IN (" & StrDEPT_OBS & ") "

    Else
        strSQL = strSQL & "tbUpload.OPR_STAT_ID IN (" & StrStat   us & ") "
   End If



    If StrAccounts = "Lugging" Then
        strSQL = strSQL & "tbUpload.ACCT like (" & [0801] & ")"

    Else
    End If

    If StrAccounts = "Structure" Then
     strSQL = strSQL & "tbUpload.ACCT IN (" & [1108] & [1114] & [1117] & [1113] & [1110] & ") "

    Else
    End If

Upvotes: 1

Views: 174

Answers (1)

June7
June7

Reputation: 21379

Consider:

'get selections from DEPT_OBS multiselect listbox
For Each Varitem In Me.List_Dept_OBS.ItemsSelected
   StrDEPT_OBS = StrDEPT_OBS & ",'" & Me.List_Dept_OBS.ItemData(Varitem) & "'"
Next

If Len(StrDEPT_OBS) > 0 Then
    StrDEPT_OBS = "[Dept_ID] IN(" & Right(StrDEPT_OBS, Len(StrDEPT_OBS) - 1) & ") AND "
Else
    MsgBox "You must enter an OBS"
    Exit Sub
End If

'get selections from Status multiselect listbox
For Each Varitem In Me.List_Status.ItemsSelected
    StrStatus = StrStatus & ",'" & Me.List_Status.ItemData(Varitem) & "'"
Next

If Len(StrStatus) > 0 Then
   StrStatus = "[OPR_STAT_ID] IN(" & Right(StrStatus, Len(StrStatus) - 1) & ") AND "
End If

'get selection from Accts single select listbox and build account parameters array
Select Case Me.List_Accts
    Case "Picking"
        StrAccounts = "ACCT = 0801 AND "
    Case "Placed_Orders"
        StrAccounts = "ACCT IN(1108,1114,1117,1113,1110) AND "
    Case "Not_Placed"
        StrAccounts = "NOT ACCT IN(0801,1108,1114,1117,1113,1110) AND "
End Select

strSQL = StrDEPT_OBS & StrStatus & StrAccounts
If strSQL <> "" Then
    strSQL = " WHERE " & Left(strSQL, Len(strSQL) - 5)
End If

Me.[tbUpload subform].Form.RecordSource = "SELECT * FROM tbUpload" & strSQL & ";"

For more info on dynamically building search criteria with VBA, review http://allenbrowne.com/ser-62.html

Upvotes: 0

Related Questions