Results 1 to 7 of 7
  1. #1
    Join Date
    Oct 2003
    Posts
    15

    Unanswered: Cascading Combo Box problem

    I have a client table and a location table and a contact table.

    The contacts are tied to a specific location within a client.


    What I'm trying to do is build a form with a combo box for the client
    based on the client they choose, they would next use another combo box to select the location within that client. Below that, there is a subform query listing all of the contacts and their information for that client-location.


    How to I populate the location combo box with only the locations for the client selected in the client combo?


    Thanks!
    Chris
    Last edited by cmbehan; 05-18-04 at 15:46. Reason: title update

  2. #2
    Join Date
    Mar 2003
    Location
    The Bottom of The Barrel
    Posts
    6,102
    Provided Answers: 1
    Search the forums for "Cascading Combo Box"
    oh yeah... documentation... I have heard of that.

    *** What Do You Want In The MS Access Forum? ***

  3. #3
    Join Date
    Oct 2003
    Posts
    15
    The search function wasn't working for me, so I googled it and got this page:
    http://www.fontstuff.com/access/acctut10.htm
    That page has a bunch of info, and I'm trying to follow example 2 and it's still not working.


    Can someone please take a look at the form called GroupLoc in the attached dB and tell me what I'm missing?


    Thanks a ton in advance!

    Chris
    Attached Files Attached Files

  4. #4
    Join Date
    Oct 2003
    Posts
    15
    bump to beg for help!

    Thanks!

  5. #5
    Join Date
    Mar 2004
    Location
    Nashville, TN
    Posts
    557
    I can do it with listboxes so I assume the code would be similar... See if you can make anything of the code below.

    Code:
    Option Compare Database
    Dim SeriesID As Integer
    Dim ClassID As String
    Dim ToolID As String
    
    Private Function dseries()
    SeriesID = lst3.Value
        With lstParts
            .ColumnCount = 3
            .ColumnHeads = True
            .RowSourceType = "Table/Query"
            .RowSource = "SELECT Parts.PartID, Parts.Description, Parts.Series FROM Parts WHERE Parts.Series =" & SeriesID
        End With
    End Function
    
    Private Function dclass()
        ClassID = lst3.Value
        With lstParts
            .ColumnCount = 3
            .ColumnHeads = True
            .RowSourceType = "Table/Query"
            .RowSource = "SELECT Parts.PartID, Parts.Description, Parts.PClass FROM Parts WHERE Parts.PClass =" & Chr$(34) & ClassID & Chr$(34)
        End With
    End Function
    
    Private Function dboth()
        ClassID = lst4.Value
        SeriesID = lst3.Value
            With lstParts
                .ColumnCount = 2
                .ColumnHeads = True
                .RowSourceType = "Table/Query"
                .RowSource = "SELECT Parts.PartID, Parts.Description, Parts.Series, Parts.PClass FROM Parts WHERE Parts.Series =" & SeriesID & "AND Parts.PClass =" & Chr$(34) & ClassID & Chr$(34)
            End With
    End Function
    
    Private Function dtools()
        ToolID = lst3.Value
            With lstParts
                .ColumnCount = 3
                .ColumnHeads = True
                .RowSourceType = "Table/Query"
                .RowSource = "SELECT Parts.PartID, Parts.Description, Parts.ToolID FROM Parts WHERE Parts.ToolID=" & Chr$(34) & ToolID & Chr$(34)
            End With
    End Function
    
    Private Sub cmdAddtolst_Click()
    Dim existing As Boolean
    Dim s As String
    existing = False
    s = lstParts.Column(PartID)
    For i = 0 To (lstSelectedParts.ListCount - 1)
        If lstSelectedParts.Column(PartID, i) = s Then
            existing = True
        End If
    Next i
    
    If existing Then
        MsgBox "This part is already in the list."
    Else
        lstSelectedParts.RowSourceType = "Value List"
        lstSelectedParts.AddItem (lstParts)
    End If
    
    End Sub
    
    Private Sub cmdFindParts_Click()
        On Error GoTo cmdFindParts_Err
    lstParts.Visible = True
    If lst2.Value = "Series" Then
        SeriesID = lst3.Value
        Call dseries
    ElseIf lst2.Value = "Class" Then
        ClassID = lst3.Value
        Call dclass
    ElseIf lst2.Value = "Both" Then
        ClassID = lst4.Value
        SeriesID = lst3.Value
        Call dboth
    ElseIf lst2.Value = "Tools" Then
        ToolID = lst3.Value
        Call dtools
    End If
    
    cmdFindParts_Exit:
        Exit Sub
    
    cmdFindParts_Err:
        MsgBox Err.Description
        Resume cmdFindParts_Exit
    End Sub
    
    Private Sub lst1_AfterUpdate()
        On Error GoTo lst1_err
        If lst1.Value = "Parts" Then
            lst3.Visible = False
            lst4.Visible = False
            cmdFindParts.Visible = True
            With lst2
                .Visible = True
                .Enabled = True
                .RowSourceType = "Value List"
                .RowSource = "Series;Class;Both"
                .ColumnCount = 1
                .ColumnHeads = False
                .ColumnWidths = "1 in"
                .Width = 900
                .Height = 720
            End With
        'ElseIf lst1.Value = "Tools" Then
        '    lst3.Visible = False
        '    lst4.Visible = False
        '    cmdFindParts.Visible = False
        '    With lst2
        '        .Visible = True
        '        .Enabled = True
        '        .RowSourceType = "Table/Query"
        '        .RowSource = "SELECT Tools.ToolID, Tools.Description, Tools.Width, Tools.Length, Tools.Depth, * FROM Tools;"
        '        .ColumnCount = 5
        '        .ColumnHeads = True
        '        .ColumnWidths = ".75 in; 3 in; .35 in; .45 in; .35 in"
        '        .Width = 7380
        '        .Height = 2460
        '    End With
        End If
        
    lst1_exit:
        Exit Sub
    
    lst1_err:
        MsgBox Err.Description
        Resume lst1_exit
    End Sub
    
    Private Sub cmdRfromlst_Click()
    On Error GoTo cmdRfromlst_err
        lstSelectedParts.RemoveItem (lstSelectedParts.ListIndex)
    
    cmdRfromlst_exit:
        Exit Sub
        
    cmdRfromlst_err:
        MsgBox "Please select a part to remove."
        Resume cmdRfromlst_exit
    End Sub
    
    Private Sub Form_Load()
        lstSelectedParts.RowSource = ""
        lstParts.RowSource = ""
        lst3.Visible = False
        lst4.Visible = False
    End Sub
    
    Private Sub lst2_AfterUpdate()
        On Error GoTo lst2_err
        If lst2.Value = "Series" Then
            lstParts.RowSource = ""
            lst4.Visible = False
            With lst3
                .Visible = True
                .Enabled = True
                .ColumnCount = 2
                .ColumnHeads = True
                .Width = 3000
                .RowSourceType = "Value List"
                .RowSource = "SeriesID, Series Name;1, Flat Stock;2, Scallop;3, Botsko;4, Shaw Traditional;5, Ernst;6, Shaw Special;7, Fluted;8, Vase;9, Accessories"
            End With
        ElseIf lst2.Value = "Class" Then
            lstParts.RowSource = ""
            lst4.Visible = False
            With lst3
                .Visible = True
                .Enabled = True
                .ColumnCount = 2
                .ColumnHeads = True
                .Width = 3000
                .RowSourceType = "Value List"
                .RowSource = "ClassID, Class Name;HD, Header;TR, Trim;SP, Special;BL, Balustrade;CP, Coping/Cap;SL, Sill"
            End With
        
        ElseIf lst2.Value = "Both" Then
            lstParts.RowSource = ""
            With lst3
                .Visible = True
                .Enabled = True
                .ColumnCount = 2
                .ColumnHeads = True
                .Width = 3000
                .RowSourceType = "Value List"
                .RowSource = "SeriesID, Series Name;1, Flat Stock;2, Scallop;3, Botsko;4, Shaw Traditional;5, Ernst;6, Shaw Special;7, Fluted;8, Vase;9, Accessories"
            End With
            With lst4
                .Visible = True
                .Enabled = True
                .ColumnCount = 2
                .ColumnHeads = True
                .Width = 3000
                .RowSourceType = "Value List"
                .RowSource = "ClassID, Class Name;HD, Header;TR, Trim;SP, Special;BL, Balustrade;CP, Coping/Cap;SL, Sill"
            End With
        ElseIf lst2.Value = "Tools" Then
            lstParts.RowSource = ""
            lst4.Visible = False
            With lst3
                .Visible = True
                .Enabled = True
                .ColumnCount = 5
                .ColumnHeads = True
                .ColumnWidths = ".75 in; 3 in; .35 in; .45 in; .35 in"
                .Width = 8250
                .RowSourceType = "Table/Query"
                .RowSource = "SELECT Tools.ToolID, Tools.Description, Tools.Width, Tools.Length, Tools.Depth, * FROM Tools;"
            End With
        End If
    
    lst2_exit:
        Exit Sub
    
    lst2_err:
        MsgBox Err.Description
        Resume lst2_exit
        
    End Sub
    Private Sub lst2_AfterUpdate() is the first listbox in the sequence. You should be able to follow it from there. (I have 4 values in that box that could be selected: Series, Class, Both, and Tools).

    Let me know if you need more help,
    JS


    Edit:
    Private Sub lst1_AfterUpdate() is no longer a valid listbox on my form I just never removed it from the form because I thought I might use it again later.
    Have you ever thought about thinking on purpose?

    Jarvis Stubblefield
    Patriot Designs
    Web/Database Development and Consulting
    The-Patriot.net by Patriot Designs

  6. #6
    Join Date
    Oct 2003
    Posts
    15

    Unhappy

    JS, thanks but that was a bit over my head.

  7. #7
    Join Date
    Mar 2004
    Location
    Nashville, TN
    Posts
    557
    Okay when I get sometime... I may be able to explain the bits of code to you. If you could tell me which parts you do and dont understand I may be able to help you faster.

    JS
    Have you ever thought about thinking on purpose?

    Jarvis Stubblefield
    Patriot Designs
    Web/Database Development and Consulting
    The-Patriot.net by Patriot Designs

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •