Selecting values from listboxes

[mrsbean]

I know what I want to do, and yet I'm really stumped on how to do it. I've seen something similar, but I've been at it for 2 days now, and I can't figure it out.

After I click on the first listbox (lbxYear) I want to determine with code whether the next listbox contains only one record. If the next listbox contains only one record, I want it to automatically select it, and so on and so on until I get to the last lisbox (lbxEngineSize). After the list selection is made (lbxEngineSize) I want it carry out a series of steps in code.

I am always very grateful for help,

MrsBean

Private Sub lbxYear_Click()
On Error GoTo Err_lbxYear_Click

Dim strSQL As String

Me.objProducts.Visible = False

If AssignPartsNew = False Then

Me.lbxMake.Requery
Me.lbxModel.Requery
Me.lbxBodyStyle.Requery
Me.lbxEngineSize.Requery


End If
Exit_lbxYear_Click:
    Exit Sub

Err_lbxYear_Click:
    MsgBox Err.Description, vbExclamation, "Error"
    Resume Exit_lbxYear_Click

End Sub

Public Sub lbxMake_Click()
On Error GoTo Err_lbxMake_Click

Me.objProducts.Visible = False

If AssignPartsNew = False Then
Dim strSQL As String
    Me.lbxModel.Requery
    Me.lbxBodyStyle.Requery
    Me.lbxEngineSize.Requery

    End If

Exit_lbxMake_Click:
    Exit Sub

Err_lbxMake_Click:
    MsgBox Err.Description, vbExclamation, "Error"
    Resume Exit_lbxMake_Click

End Sub

Public Sub lbxModel_Click()
On Error GoTo Err_lbxModel_Click
    Me.objProducts.Visible = False

If AssignPartsNew = False Then
Dim strSQL As String

    Me.lbxBodyStyle.Requery
    Me.lbxEngineSize.Requery



End If

Exit_lbxModel_Click:
    Exit Sub

Err_lbxModel_Click:
    MsgBox Err.Description, vbExclamation, "Error"
    Resume Exit_lbxModel_Click

End Sub

Private Sub lbxBodyStyle_Click()
On Error GoTo Err_lbxBodyStyle_Click

Me.objProducts.Visible = False

If AssignPartsNew = False Then
Dim strSQL As String

    Me.lbxEngineSize.Requery


End If

Exit_lbxBodyStyle_Click:
    Exit Sub

Err_lbxBodyStyle_Click:
    MsgBox Err.Description, vbExclamation, "Error"
    Resume Exit_lbxBodyStyle_Click

End Sub
Private Sub lbxEngineSize_Click()
On Error GoTo Err_lbxEngineSize_Click

If AssignPartsNew = False Then
Dim strLinkCriteria As String
Dim strSQL As String

    strSQL = strSQL + "SELECT DISTINCT tblVehicle.EngineSize, tblVehicle.BodyStyle, tblVehicle.Model, "
    strSQL = strSQL + "tblVehicle.Model, tblVehicle.Make, tblVehicle.Year FROM tblVehicle "
    strSQL = strSQL + "WHERE (((tblVehicle.Year) = '" & Me.lbxYear & "'" & ") And "
    strSQL = strSQL + "((tblVehicle.Make) = '" & Me.lbxMake & "'" & ") And "
    strSQL = strSQL + "((tblVehicle.Model) = '" & Me.lbxModel & "'" & ") And "
    strSQL = strSQL + "((tblVehicle.BodyStyle) = '" & Me.lbxBodyStyle & "'" & ") And "
    strSQL = strSQL + "((tblVehicle.EngineSize) = '" & Me.lbxEngineSize & "'" & ")) "




    strLinkCriteria = "Year = Forms!frmAssignPart!lbxYear And "
    strLinkCriteria = strLinkCriteria + "Make = Forms!frmAssignPart!lbxMake And "
    strLinkCriteria = strLinkCriteria + "Model = Forms!frmAssignPart!lbxModel And "
    strLinkCriteria = strLinkCriteria + "BodyStyle = Forms!frmAssignPart!lbxBodyStyle And "
    strLinkCriteria = strLinkCriteria + "EngineSize = Forms!frmAssignPart!lbxEngineSize "
    'strLinkCriteria = strLinkCriteria + "VehicleID = Forms!frmAssignPart!VehicleID "
    'strLinkCriteria = strLinkCriteria + "AC = Forms!frmAssignPart!lbxAC"

    Me.objProducts.Visible = True
     Forms![frmAssignPart]![objProducts].[Form]![cbxStockNoEntry] = ""
     Forms![frmAssignPart]![objProducts].Form![cbxEatonNoEntry] = ""


    'Me.objProducts.SourceObject = "sfrmProducts"
    DoCmd.ApplyFilter , strLinkCriteria
    Forms!frmAssignPart!objProducts.SetFocus
    DoCmd.GoToControl ("cbxStockNoEntry")

    End If

Exit_lbxEngineSize_Click:
    Exit Sub

Err_lbxEngineSize_Click:
    MsgBox Err.Description, vbExclamation, "Error"
    Resume Exit_lbxEngineSize_Click

End Sub

 

[Zion7]

You can use the ListCount, property.
And the Selected, Property.

If lbxBodyStyle.ListCount = 1 Then
lbxBodyStyle.Selected(0) = True
End If

 

[mrsbean]

Zion7,

This was the basic idea behind what I had that kept breaking on me. I would repeat the basic idea less one outside level for each subsequent listbox. Problem was that when it got to a listbox that did have more than one record (they all have at least one record), I got nothing in the list.

Here is the code to for the rowsource of lbxEngineSize:

SELECT DISTINCT tblVehicle.EngineSize, tblVehicle.Year, tblVehicle.Make, tblVehicle.Model, tblVehicle.BodyStyle FROM tblVehicle WHERE (((tblVehicle.Year)=[Forms]![frmAssignPart]![lbxYear]) AND ((tblVehicle.Make)=[Forms]![frmAssignPart]![lbxMake]) AND ((tblVehicle.Model)=[Forms]![frmAssignPart]![lbxModel]) AND ((tblVehicle.BodyStyle)=[Forms]![frmAssignPart]![lbxBodyStyle]));

And here is the code I had for lbxYear list box on click:

Private Sub lbxYear_Click()
On Error GoTo Err_lbxYear_Click

Dim strSQL As String

Me.objProducts.Visible = False

If AssignPartsNew = False Then

Me.lbxMake.Requery
Me.lbxModel.Requery
Me.lbxBodyStyle.Requery
Me.lbxEngineSize.Requery

If lbxMake.ListCount = 1 Then
lbxModel.Selected(0) = True

Me.lbxBodyStyle.Requery
Me.lbxEngineSize.Requery

     If lbxBodyStyle.ListCount = 1 Then
     lbxBodyStyle.Selected(0) = True

     Me.lbxEngineSize.Requery
            If.lbxEngineSize.ListCount = 1 Then
            lbxEngineSize.Selected(0) = True
            End IF
     End If
End If

Exit_lbxYear_Click:
    Exit Sub

Err_lbxYear_Click:
    MsgBox Err.Description, vbExclamation, "Error"
    Resume Exit_lbxYear_Click

End Sub

 

[Zion7]

I'm sorry mrsbean, I don't quite understand your objective.

"Problem was that when it got to a listbox that did have more than one record (they all have at least one record), I got nothing in the list. "
...you get nothing, in which list?

Is everything fine now?

 

[mrsbean]

No. When there is more than one record in the next listbox, the listbox doesn't fill. It stops there, and all of the listboxes after that are blank.

The objective is to have the selection automated as much as possible for the user. When there's only one selection available, pick that one. When there's more than one selection available, wait for input (a click) and then fill the next listbox based on the selected criteria.

 

[Zion7]

it's because your logic is off, not your properties.

Requerying, should not be contigent upon a selection.
Only an automated selection, is contigent upon only having a single choice.
MEANING, your first IF STATEMENT, encompasses, all the following actions.
It should ONLY be for an automated selection.

NOT THIS...

If lbxMake.ListCount = 1 Then
lbxModel.Selected(0) = True
Me.lbxBodyStyle.Requery
Me.lbxEngineSize.Requery

If lbxBodyStyle.ListCount = 1 Then
lbxBodyStyle.Selected(0) = True
Me.lbxEngineSize.Requery
If.lbxEngineSize.ListCount = 1 Then
lbxEngineSize.Selected(0) = True
End IF
End If
End If

BUT THIS...

If lbxMake.ListCount = 1 Then
lbxModel.Selected(0) = True
Me.lbxBodyStyle.Requery
End If

If lbxBodyStyle.ListCount = 1 Then
lbxBodyStyle.Selected(0) = True
Me.lbxEngineSize.Requery
End If


If.lbxEngineSize.ListCount = 1 Then
lbxEngineSize.Selected(0) = True
End IF

 

[mrsbean]

I know it's been a while since I looked at this board. Someone eventually helped me with a solution to my dilemma. The other board is somewhat anonymous also, I can't give proper credit to the user, but I think it's simple and elegant

MrsBean

Private Sub lbxBodyStyle_AfterUpdate()
    On Error Resume Next
    Me.lbxEngineSize.Requery
    Me.lbxEngineSize = Me.lbxEngineSize.ItemData(0)
    On Error GoTo 0
End Sub

Private Sub lbxMake_AfterUpdate()
    On Error Resume Next
    Me.lbxModel.Requery
    Me.lbxModel = Me.lbxModel.ItemData(0)
    lbxModel_AfterUpdate
    On Error GoTo 0
End Sub

Private Sub lbxModel_AfterUpdate()
    On Error Resume Next
    Me.lbxBodyStyle.Requery
    Me.lbxBodyStyle = Me.lbxBodyStyle.ItemData(0)
    lbxBodyStyle_AfterUpdate
    On Error GoTo 0
End Sub

'Year is clicked first
Private Sub lbxYear_AfterUpdate()
    On Error Resume Next
    Me.lbxMake.Requery
    Me.lbxMake = Me.lbxMake.ItemData(0)
    lbxMake_AfterUpdate
    On Error GoTo 0
End Sub