Search code examples
excelvbacomboboxvlookupuserform

Excel VBA Userform combobox1 selection filters combobox2 based off of combobox1 selection


So I'm trying to use three Comboboxes to have a selection list for data input. I'm needing to make a selection in this order: Region -> Site -> Maintenance Plant. When a selection is made in the Region Combobox, then the Site Combobox list should filter to the options that pertain to the corresponding Region selection. Im thinking either a pivot table or vLookup needs to be used but I'm at a loss and have no clue how to get this done. Please help and thank you very much in advance.

    Private Sub UserForm_Initialize()
    Dim CreateBy As Range
    Dim Region As Range
    Dim Site As Range
    Dim MaintPlant As Range
    Dim Dept As Range
    Dim Act As Range
    Dim ImpActTyp As Range
    Dim ValCat As Range
    Dim ws As Worksheet
    Set ws = Worksheets("LookupLists")
    
    
    For Each CreateBy In ws.Range("RosterList")
      With Me.CboCreateBy
        .AddItem CreateBy.Value
      End With
    Next CreateBy
    
    For Each Region In ws.Range("RegionList")
      With Me.CboRegion
        .AddItem Region.Value
      End With
    Next Region
    
    For Each Site In ws.Range("SiteList")
      With Me.CboSite
        .AddItem Site.Value
      End With
    Next Site
    
    For Each MaintPlant In ws.Range("MaintPlantList")
      With Me.CboMntPlant
        .AddItem MaintPlant.Value
      End With
    Next MaintPlant
    
    For Each Dept In ws.Range("DeptList")
      With Me.CboDept
        .AddItem Dept.Value
      End With
    Next Dept
    
    For Each Act In ws.Range("ActList")
      With Me.CboAct
        .AddItem Act.Value
      End With
    Next Act
    
    For Each ImpActTyp In ws.Range("ImpActTypList")
      With Me.CboImpActTyp
        .AddItem ImpActTyp.Value
      End With
    Next ImpActTyp
    
    For Each ValCat In ws.Range("ValCatList")
      With Me.CboValCat
        .AddItem ValCat.Value
      End With
    Next ValCat
    
    Me.DateTextBox.Value = Format(Date, "Medium Date")
    Me.PLife.Value = 0
    Me.CSE.Value = 0
    Me.CboRegion.SetFocus
End Sub

Combo boxes

Table


Solution

  • Get ready, because I'm about to reimagine your entire code here. I strongly recommend you create a backup of your original code module or workbook just due to the vast differences and if our ideas didn't align properly.

    This will perform real-time filtering on your table, so keep this in mind using this method.

    I did perform some testing on the following code, but I am human and threw this together in 20 mins or so. I wouldn't implement this in a real setting until you have fully tested the code and are comfortable with it.

    And I just wanted to thank you for your use of Named Ranges. This made coding this easier.

    You must enable the Microsoft Scripting Runtime library. This is used to grab the unique values from your tables. (Tools > References)

    enter image description here

    So to get things started, here is the entire code for your userform's code module:

    Option Explicit
    Private ws As Worksheet
    Private tblLO As ListObject
    
    Private Sub combo_region_Change()
    
        Application.EnableEvents = False
        
        Me.combo_maintPlant.Clear
        Me.combo_site.Clear
        
        'This is the first filter, so no worries about clearing entire AutoFilter
        tblLO.AutoFilter.ShowAllData
    
        Select Case Me.combo_region.Value
        Case ""
            Me.combo_site.Value = ""
            Me.combo_maintPlant.Value = ""
            Me.combo_site.Enabled = False
            Me.combo_maintPlant.Enabled = False
        Case Else
            'If data is entered into first combobox, filter the table
            tblLO.Range.AutoFilter 1, Me.combo_region.Value
            
            'Populate the site combo box with new data
            populateSiteCombo
            
            'Enable the Site Combobox for user input
            Me.combo_site.Enabled = True
        End Select
        
        Application.EnableEvents = True
    
    End Sub
    
    Private Sub combo_site_Change()
    
        Application.EnableEvents = False
        
        Me.combo_maintPlant.Clear
        
        'Clear the filtering, then readd the Region's filter
        tblLO.AutoFilter.ShowAllData
        tblLO.Range.AutoFilter 1, Me.combo_region
    
        Select Case Me.combo_site.Value
        Case ""
            Me.combo_maintPlant.Value = ""
            Me.combo_maintPlant.Enabled = False
        Case Else
            'If data is entered into first combobox, filter the table
            tblLO.Range.AutoFilter 2, Me.combo_site.Value
            
            'Populate the Plant combo box with new data
            populatePlantCombo
            
            'Enable the Plant Combobox for user input
            Me.combo_maintPlant.Enabled = True
        End Select
        
        Application.EnableEvents = True
    
    End Sub
    
    Private Sub populatePlantCombo()
    
        'Grab unique values from Region column using Dictionary
        Dim i As Long, regionDict As New Scripting.Dictionary
        Dim arrReg() As Variant
        
        'If it filters only 1 item, then it's just a single cell and not an arr
        With ws.Range("MaintPlantList").SpecialCells(xlCellTypeVisible)
            If .Count = 1 Then
                Me.combo_maintPlant.AddItem .Value
                Exit Sub
            Else
                arrReg = .Value
            End If
        End With
        
        With New Scripting.Dictionary
            For i = 1 To UBound(arrReg)
                If Not .Exists(arrReg(i, 1)) Then
                    .Add arrReg(i, 1), "" 'We only add to dictionary for tracking
                    Me.combo_maintPlant.AddItem arrReg(i, 1)
                End If
            Next
        End With
    
    End Sub
    
    Private Sub populateSiteCombo()
    
        'Grab unique values from Region column using Dictionary
        Dim i As Long, regionDict As New Scripting.Dictionary
        Dim arrReg() As Variant
        
        'If it filters only 1 item, then it's just a single cell and not an arr
        With ws.Range("SiteList").SpecialCells(xlCellTypeVisible)
            If .Count = 1 Then
                Me.combo_site.AddItem .Value
                Exit Sub
            Else
                arrReg = .Value
            End If
        End With
        
        With New Scripting.Dictionary
            For i = 1 To UBound(arrReg)
                If Not .Exists(arrReg(i, 1)) Then
                    .Add arrReg(i, 1), "" 'We only add to dictionary for tracking
                    Me.combo_site.AddItem arrReg(i, 1)
                End If
            Next
        End With
    
    End Sub
    
    Private Sub populateRegionCombo()
    
        'Grab unique values from Region column using Dictionary
        Dim i As Long, regionDict As New Scripting.Dictionary
        Dim arrReg() As Variant
        arrReg = ws.Range("RegionList").Value
        With New Scripting.Dictionary
            For i = 1 To UBound(arrReg)
                If Not .Exists(arrReg(i, 1)) Then
                    .Add arrReg(i, 1), "" 'We only add to dictionary for tracking
                    Me.combo_region.AddItem arrReg(i, 1)
                End If
            Next
        End With
    
    End Sub
    
    Private Sub UserForm_Initialize()
    
        Set ws = ThisWorkbook.Worksheets("LookupLists") 'Module-defined var
        Set tblLO = ws.ListObjects("Table1")            'Module-defined var
        
        tblLO.AutoFilter.ShowAllData
    
        Me.combo_maintPlant.Enabled = False
        Me.combo_site.Enabled = False
        
        'We only populate this one during init because the others
        'will populate once a value is used in this box
        populateRegionCombo
        
    End Sub
    

    If you decided to scroll down to understand what's going on here, then great.

    Let's start with the initialization:

    Private Sub UserForm_Initialize()
    
        Set ws = ThisWorkbook.Worksheets("LookupLists") 'Module-defined var
        Set tblLO = ws.ListObjects("Table1")            'Module-defined var
        
        tblLO.AutoFilter.ShowAllData
    
        Me.combo_maintPlant.Enabled = False
        Me.combo_site.Enabled = False
        
        'We only populate this one during init because the others
        'will populate once a value is used in this box
        populateRegionCombo
    
    End Sub
    

    We defined the module variables ws and tblLO. I'm not a huge fan of module-scoped variables, but we can usually get along when they are private vars to a userform module. Now the other functions in the code module can access these.

    We reset autofiltering and disabled the two combo boxes that shouldn't be used until a selection is made for the region. Only after the region is selected will the next box be available for selection. We will handle these using Change Events for the comboboxes.

    The userform is mostly controlled by the combo_region_change and combo_site_change events. Everytime region_change is fired, it will clear all the other combo boxes to redetermine it's new value. Then it will refilter as appropriately. The combo_site does the same, but it only clears the maintaince box. These event handlers also establish which of the other combox boxes are enabled depending on their values. So if you where to completely clear the site box for example, it will disable access to the Plant box again.

    Finally you just have the "populate subs". Their jobs are simply to (re)populate the next combo box once the appropriate event handler is triggered.

    enter image description here

    Tip: If you feel the need to reset the filtering once you close your userform, you can just place the code to reset it in a UserForm_Terminate() event. It makes no difference to the above code if autofilter is enabled or not prior to it running, so that is preference only.