Open form with multi select list box selections

[Slez via AccessMonster.com]

I am not particularly skilled at writing visual basic code, and often copy
and modify existing code which gets me by. In this particular instance, I'm
trying to retrieve data and display in a form (called frmBOMBid) based on
selections in multi-select list box (called lstBidSelectBOM). The form opens
as desired, but always displays data as if ALL records were selected instead
of filtering as intended. The only glitch I can see is the fact that
frmBOMBid has a subform called frmBOMBidSubform and maybe the filter isn't
making it's way through to that.

Below is my code for the command button which opens the frmBOMBid. I greatly
appreciate any help!

Private Sub cmdCopyBOMBidInfo_Click()
On Error GoTo Err_cmdCopyBOMBidInfo_Click

Dim ctlSource As Control
Dim strItems As String
Dim intProjectID As Integer
Dim intCurrentRow As Integer, SelectedRows As Integer
Set ctlSource = Me.lstBidSelectBOM
intProjectID = Forms!frmMainScreen!cboProjectMatl
'Debug.Print intProjectID


For intCurrentRow = 0 To ctlSource.ListCount - 1
If ctlSource.Selected(intCurrentRow) Then
If SelectedRows >= 1 Then
strItems = strItems & " or BidNumber = "
End If
strItems = strItems & ctlSource.Column(0, intCurrentRow)
SelectedRows = SelectedRows + 1
End If
Next intCurrentRow
strItems = strItems
If Len(strItems) = 0 Then
MsgBox "You did not select anything from the list. " _
, vbExclamation, "Nothing selected!"
Exit Sub
End If

strCriteria = "BidNumber = "
strCriteria = strCriteria & strItems
'Debug.Print strCriteria
strCriteria = "(" & strCriteria & ")" & " and ProjectID = " &
intProjectID
'Debug.Print strCriteria

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "frmBOMBid"
DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_cmdCopyBOMBidInfo_Click:
Exit Sub

Err_cmdCopyBOMBidInfo_Click:
MsgBox Err.Description
Resume Exit_cmdCopyBOMBidInfo_Click

End Sub

 

[Steve Sanford]

I don't know what the data looks like in the list box, but this should get
you started:

**** UNTESTED ****
'------------------------------------------
Private Sub cmdCopyBOMBidInfo_Click()
On Error GoTo Err_cmdCopyBOMBidInfo_Click

Dim ctlSource As Control
Dim vItem ' must be a variant

Dim intProjectID As Integer
Dim intCurrentRow As Integer, SelectedRows As Integer

Dim stDocName As String
Dim stLinkCriteria As String
' Dim strItems As String


Set ctlSource = Me.lstBidSelectBOM

intProjectID = Forms!frmMainScreen!cboProjectMatl
'Debug.Print intProjectID

'check if anything was selected
If ctlList.ItemsSelected.Count = 0 Then
MsgBox "You did not select anything from the list. " _
, vbExclamation, "Nothing selected!"
Exit Sub
End If

'loop thru the selected items in the list box
For Each vItem In ctlList.ItemsSelected
strCriteria = strCriteria & "BidNumber = "
strCriteria = strCriteria & ctlSource.Column(0, vItem)
strCriteria = strCriteria & " or "
Next

' ???????
' don't know wht this is for
' strItems = strItems

Debug.Print strCriteria

'remove the last 4 chars
strCriteria = Left(strCriteria, Len(strCriteria) - 4)
Debug.Print strCriteria

'add the proj ID
strCriteria = "(" & strCriteria & ")" & " and ProjectID = " & intProjectID
Debug.Print strCriteria

' open the form
stDocName = "frmBOMBid"
DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_cmdCopyBOMBidInfo_Click:
Exit Sub

Err_cmdCopyBOMBidInfo_Click:
MsgBox Err.Description
Resume Exit_cmdCopyBOMBidInfo_Click

End Sub
'------------------------------------------------------

HTH

 

[John_G via AccessMonster.com]

Hi -

You are opening your form using stLinkCriteria as the criteria string, but
you have the criteria in strCriteria. Since stLinkCriteria is blank, you get
all the records.

Try:

DoCmd.OpenForm stDocName, , , strCriteria

John

 

[Steve Sanford]

Thanks, John. Good catch. I thought I had changed that, but, once again, the
computer did what it wanted, not what * I * wanted it to do

Here is the correction:

'----------------------------------------
stDocName = "frmBOMBid"
DoCmd.OpenForm stDocName, , , strCriteria
'----------------------------------------



HTH