Select from two list boxes

[valkyry]

Hi,
I can't figure out how to edit this module to process from two separate list boxes.

This module runs from selection(s) from a single list box.
I also need it to process selection(s) from another list box named "RepSelector" from the query "SalesRep"

Can someone help me?


Here's the working module for one list box.

Private Sub cmdRunReport_Click()
On Error GoTo Err_cmdRunReport_Click
Dim MyDB As Database
Dim qdf As QueryDef
Dim i As Integer, strSQL As String
Dim strWhere As String, strIN As String
Dim flgAll As Boolean

Set MyDB = CurrentDb()

strSQL = "SELECT * FROM AR1_CustomerMaster"

'create the IN string by looping thru the listbox
For i = 0 To TerritorySelector.ListCount - 1
If TerritorySelector.Selected(i) Then
If TerritorySelector.Column(0, i) = " All" Then
flgAll = True
End If
strIN = strIN & "'" & TerritorySelector.Column(0, i) & "',"
End If
Next i

'create the WHERE string, stripping off the last comma of the IN string
strWhere = " WHERE [State]in (" & Left(strIN, Len(strIN) - 1) & ")"

'if "All" was selected, don't add the WHERE condition
If Not flgAll Then
strSQL = strSQL & strWhere
End If

MyDB.QueryDefs.Delete "Territory"
Set qdf = MyDB.CreateQueryDef("Territory", strSQL)

DoCmd.RunMacro "Process"

Exit_cmdRunReport_Click:
Exit Sub

Err_cmdRunReport_Click:
If Err.Number = 3265 Then '*** if the error is the query is missing
Resume Next '*** then skip the delete line and resume on the next line
ElseIf Err.Number = 5 Then
MsgBox "You must make at least one selection"
Resume Exit_cmdRunReport_Click
Else
MsgBox Err.Description '*** write out the error and exit the sub
Resume Exit_cmdRunReport_Click
End If

End Sub

 

[Eupher]

Ummm... How do you want the 2nd listbox to figure into this? What precisely do you want your code to do?

Ken S.

 

[valkyry]

Hi Ken,
I need the report to use selection(s) from both list boxes.

As it is now, it's just from one list box.

Did that make sense?

 

[TheAceMan1]

How are ya valkyry . . .

What you need to do is call a [blue]common routine[/blue] that validates both listboxes have selections and process from their!

[blue]Your Thoughts?[/blue]

See Ya! . . . . . .

 

[valkyry]

Hi TheAceMan1,
could you tell me how within the current module?

NOTE: I did not write the module myself. I had help. Now I need it altered to process from two list boxes as noted.

specifics will help as I'm not a programmer :-(


Thanks!

 

[TheAceMan1]

valkyry . . .

Are you looking to run the code seperately for each listbox or combine the selections?

See Ya! . . . . . .

 

[TheAceMan1]

valkyry . . .

So I know were on the same page, are you saying you want [blue] strIN[/blue] to include selections from both listboxes or do you want the code to run seperately for each?

If [blue]" All"[/blue] is included in both listboxes how do you intend to handle them?

In the meantime here's your code cleaned up a little:

[blue]   Dim MyDB As Database, qdf As QueryDef, LBx As ListBox, SQL As String
   Dim strWhere As String, strIN As String, flgAll As Boolean, i
   
   If Me!TerritorySelector.ItemsSelected.Count = 0 Then
      MsgBox "No Items Selected"
      Exit Sub
   End If
   
   Set MyDB = CurrentDb()
   Set LBx = Me!TerritorySelector
   SQL = "SELECT * FROM AR1_CustomerMaster"
   
   [green]'create the IN string by looping thru the listbox[/green]
   For Each i In LBx.ItemsSelected
      If LBx.Column(0, i) <> " All" Then
         strIN = strIN & "'" & TerritorySelector.Column(0, i) & "',"
      Else
         flgAll = True
         Exit For
      End If
    Next
    
   If Not flgAll Then
      [green]'create the WHERE string, stripping off the last comma of the IN string[/green]
      strWhere = " WHERE [State]in (" & Left(strIN, Len(strIN) - 1) & ")"
      SQL = SQL & strWhere
   End If
   
   MyDB.QueryDefs.Delete "Territory"
   Set qdf = MyDB.CreateQueryDef("Territory", SQL)
   
   DoCmd.RunMacro "Process"[/blue]

Also in:

[blue]   DoCmd.RunMacro "Process"[/blue]

Get away from macro's. The [blue]"Process"[/blue] should be converted to VBA . . .

[blue]Your Thoughts! . . .[/blue]

See Ya! . . . . . .

 

[valkyry]

Yes, the IN string should validate from both list boxes and the result from both.

The "All" will exist in both list boxes so that the user has an option to select "All" from both list boxes without having to select every single one from each.

Although it would be great to convert the macro to VBA, i don't know enough to do so.

The current module I got from another site. I can't remember now. Great site if you want to just download actual running code / examples like this.

 

[TheAceMan1]

valkyry . . .

Sorry to get back so late!

Add a Command Button to the form. Operations will be, user makes selections then hits command button. In the click event of the button copy/paste the following code, [blue]you![/blue] substitute proper names/values in [purple]purple[/purple]:

[blue]   Dim DB As Database, qdf As QueryDef, SQL As String
   Dim strWhere As String, strIn As String
   Dim flgAll As Integer, lbxName As String, x As Integer
   
   If (Not SelectionMade([purple][b]Me!ListboxName1[/b][/purple])) And _
      (Not SelectionMade([purple][b]Me!ListboxName2[/b][/purple])) Then
      MsgBox "No Selections Made!"
      Exit Sub
   End If
   
   Set DB = CurrentDb()
   SQL = "SELECT * FROM AR1_CustomerMaster"
   
   'create the IN string by looping thru the listboxes
   For x = 1 To 2
      lbxName = Choose(x, "[purple][b]Me!ListboxName1[/b][/purple]", "[purple][b]Me!ListboxName2[/b][/purple]")
   
      If SelectionMade(Me(lbxName)) Then
         If strIn <> "" Then strIn = strIn & ","
         
         If AllSelected(Me(lbxName)) Then
            strIn = strIn & PackAll(Me(lbxName))
            flgAll = (flgAll Or x)
         Else
            strIn = strIn & PackSelected(Me(lbxName))
         End If
          
      End If
   Next
   
   If flgAll <> 3 Then
      'create the WHERE string, stripping off the last comma of the IN string
      strWhere = " WHERE ([State] IN (" & Left(strIn, Len(strIn) - 1) & "))"
      SQL = SQL & strWhere
   End If
   
   DB.QueryDefs.Delete "Territory"
   Set qdf = DB.CreateQueryDef("Territory", SQL)
   
   DoCmd.RunMacro "Process"[/blue]

Next in code module of the form, copy/paste the following support functions:

[blue]Public Function PackAll(LBx As ListBox) As String
   Dim Pack As String, idx As Integer
   
   For idx = 0 To LBx.ListCount - 1
      If LBx.Column(0, idx) <> " All" Then
         If Pack <> "" Then
            Pack = Pack & ",'" & LBx.Column(0, idx) & "'"
         Else
            Pack = "'" & LBx.Column(0, idx) & "'"
         End If
      End If
   Next
   
   PackAll = Pack
         
End Function

Public Function PackSelected(LBx As ListBox) As String
   Dim Pack As String, idx
   
   For Each idx In LBx.ItemsSelected
      If LBx.Column(0, idx) <> " All" Then
         If Pack <> "" Then
            Pack = Pack & ",'" & LBx.Column(0, idx) & "'"
         Else
            Pack = "'" & LBx.Column(0, idx) & "'"
         End If
      End If
   Next
   
   PackSelected = Pack
End Function

Public Function SelectionMade(LBx As ListBox) As Boolean
   If LBx.ItemsSelected.Count <> 0 Then SelectionMade = True
End Function

Public Function AllSelected(LBx As ListBox) As Boolean
   Dim idx
   
   For Each idx In LBx.ItemsSelected
      If LBx.Column(0, idx) = " All" Then
         AllSelected = True
         Exit For
      End If
   Next
      
End Function[/blue]

[blue]Thats it . . . give it a whirl & let me know . . .[/blue]

See Ya! . . . . . .

 

[valkyry]

Thanks
i'll try it and let you know

 

[valkyry]

Hi,
Run Time Error 3265;
Item not found in collection.


it errored on Set qdf = DB.CreateQueryDef("Territory", SQL)

 

[valkyry]

FYI - it's not recreating the Territory query.
It did however delete it.

 

[TheAceMan1]

Roger That valkyry . . .

I'll have to start at the most likely (it may take several posts before we get done . . .).

[blue][purple]Change:[/purple]
   Dim DB As Database, qdf As QueryDef, SQL As String
[purple]To:[/purple]
   Dim [purple][b]DB As DAO.Database, qdf As DAO.QueryDef[/b][/purple], SQL As String[/blue]

The code on your incumbance in subsituting those indicated in [purple]purple1[/purple]. Please verify this (I'm sure you did)?

The code requires [purple]Microsoft DAO 3.6 Object Library[/purple] to run. To [blue]check/install[/blue] the library, in any code window click [blue]Tools[/blue] - [blue]References...[/blue] In the listing find the library and [blue]make sure its checked.[/blue] Then using the up arrow, [purple]push it up as high in priority as it will go[/purple]. Click OK.

Do the substitutions above make any difference?

See Ya! . . . . . .

 

[valkyry]

I actually had the Microsoft DAO 3.6 Object Library but it wasn't on the highest priority that it can go.

so that's done. This time it compiled.

The current error is Run-time error 3075 (State in ...)

the module error is at Set qdf = DB.CreateQueryDef("Territory", SQL)


THANKS FOR ALL YOUR HELP!

 

[TheAceMan1]

valkyry . . .

[blue][purple]Change:[/purple]
   strWhere = " WHERE ([State] IN (" & Left(strIn, Len(strIn) - 1) & "))"
[purple]To:[/purple]
   strWhere = " WHERE ([State] IN (" & strIn & "))"[/blue]

See Ya! . . . . . .

 

[valkyry]

now the following error:

Run Time Error 3265;
Item not found in collection.

at:
DB.QueryDefs.Delete "Territory

 

[TheAceMan1]

OK valkyry . . .

Ran a simulation and got it. The error is not due to the line you specified . . .

[blue]   Set qdf = DB.CreateQueryDef("Territory", SQL)[/blue]

. . . but due to the prior line . . .

[blue]   DB.QueryDefs.Delete "Territory"[/blue]

Since the query was deleted earlier, it no longer exist in the [blue]Queries Collection![/blue] Hence the collection error!

To correct this, enter the line in [purple]purple[/purple] where you see it:

[blue][purple][b]On Error Resume Next[/b][/purple]
   DB.QueryDefs.Delete "Territory"
   Set qdf = DB.CreateQueryDef("Territory", SQL)
   
   DoCmd.RunMacro "Process"

End Sub[/blue]

All the line does is allow code to continue should delete fail (due to query not found or missing).

[blue]Let me know . . .[/blue]

See Ya! . . . . . .

 

[valkyry]

Ok, now doesn't that part also need to include it for the SalesRep query like the Territory query?

How would that get added to the code?

 

[TheAceMan1]

valkyry . . .

Until your last post, [blue]this thread was only concerned with the Territory query![/blue] . . . (one thing at a time!)

[blue]Did you try the new line?[/blue]

See Ya! . . . . . .

 

[valkyry]

Yes.

if you see the modified code, it was for both Territory and Rep.

Those are the ones that's in your:
If (Not SelectionMade(Me!ListboxName1)) And _
(Not SelectionMade(Me!ListboxName2)) Then
MsgBox "No Selections Made!"
Exit Sub
End If

Set DB = CurrentDb()
SQL = "SELECT * FROM AR1_CustomerMaster"

'create the IN string by looping thru the listboxes
For x = 1 To 2
lbxName = Choose(x, "Me!ListboxName1", "Me!ListboxName2")


Please note that I just copied and did as instructed

I did notice that near the end, it only had the Territory but gave it a whirl to see what happens.