Excel, VBA, UserForm: Populate combobox based on selection in another combobox-CodePudding

I have created a userform with some comboboxes, based on combobox2 I would like to populate combobox1.

In combobox2 there are 6 items to choose from 17, 19, 21, 23, 25, 25

Based on the selected item in Combobox1 I would like to populate combobox2 as following:

If ItemA is selected, Combobox1 should be populated from range in Sheet ”supply_to_production” range (T6:T1000)

If ItemB is selected, Combobox1 should be populated from range in Sheet ”supply_to_production” range (V6:V1000)

If ItemC is selected, Combobox1 should be populated from range in Sheet ”supply_to_production” range (X6:X1000)

If ItemD is selected, Combobox1 should be populated from range in Sheet ”supply_to_production” range (Z6:Z1000)

If ItemE is selected, Combobox1 should be populated from range in Sheet ”supply_to_production” range (AB6:AB1000)

If ItemF is selected, Combobox1 should be populated from range in Sheet ”supply_to_production” range (AD 6:AD1000)

I have tried the code bellow, it is not giving me any error but is also does not give me any list in combobox1.


Private Sub UserForm_Initialize()

With ComboBox2
    .AddItem "17"
    .AddItem "19"
    .AddItem "21"
    .AddItem "23"
    .AddItem "25"
    .AddItem "25 "
End With
End Sub

Private Sub ComboBox1_Update()
Dim index As Integer
index = ComboBox2.ListIndex

ComboBox1.Clear

Select Case index

 Case "17":
  ComboBox1.List = [SUPPLY_TO_PRODUCTION!T6:T1000]
 Case "19":
  ComboBox1.List = [SUPPLY_TO_PRODUCTION!V6:V1000]
 Case "21":
  ComboBox1.List = [SUPPLY_TO_PRODUCTION!X6:X1000]
 Case "23":
  ComboBox1.List = [SUPPLY_TO_PRODUCTION!Z6:Z1000]
 Case "25":
  ComboBox1.List = [SUPPLY_TO_PRODUCTION!AB6:AB1000]
 Case "25 ":
  ComboBox1.List = [SUPPLY_TO_PRODUCTION!AD6:AD1000] 

End Select

End Sub

CodePudding user response：

Something like this should work for you:

Private Sub UserForm_Initialize()
    
    Me.ComboBox2.List = Array(17, 19, 21, 23, 25, "25 ")
    
End Sub

Private Sub ComboBox2_Change()
    
    'Don't have magic numbers, have an easy way to change hard-coded values
    Const lStartRow As Long = 6
    
    Me.ComboBox1.Clear
    Dim sColumn As String
    Select Case CStr(Me.ComboBox2.Value)
        Case "17":  sColumn = "T"
        Case "19":  sColumn = "V"
        Case "21":  sColumn = "X"
        Case "23":  sColumn = "Z"
        Case "25":  sColumn = "AB"
        Case "25 ": sColumn = "AD"
    End Select
    
    If Len(sColumn) = 0 Then Exit Sub   'No valid option selected from ComboBox2
    
    'Dynamically size the data
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("SUPPLY_TO_PRODUCTION")
    Dim rData As Range:  Set rData = ws.Range(ws.Cells(lStartRow, sColumn), ws.Cells(ws.Rows.Count, sColumn).End(xlUp))
    
    Me.ComboBox1.List = rData.Value
    
End Sub

CodePudding user response：

It looks like you're compiling, where Option Explicit may have saved you?

Try referencing the full range and using the ComboBox2.Value for your Select, such that:

Private Sub ComboBox1_Change()
    Dim columnReference as String
    Select Case ComboBox2.Value
        Case "17":
            columnReference = "T"
        Case "19":
            columnReference = "V"
        Case "21":
            columnReference = "X"
        Case "23":
            columnReference = "Z"
        Case "25":
            columnReference = "AB"
        Case "25 ":
            columnReference = "AD"
    End Select
    With Sheets("SUPPLY_TO_PRODUCTION")
        ComboBox2.List = .Range(.Cells(6,columnReference),.Cells(1000,columnReference)).Value
    End With
End Sub

Edit1: Added name of subroutine... Private Sub ComboBox1_Change(), which should trigger the event. Plus, showing images of a quick example which follows this model:

Option Explicit

Private Sub UserForm_Initialize()
    ComboBox1.List = Array("animal", "food")
End Sub


Private Sub combobox1_change()
    Dim columnReference As Long
    Select Case ComboBox1.Value
        Case "animal"
            columnReference = 1
        Case "food"
            columnReference = 2
    End Select
    With Sheets(1)
        ComboBox2.List = .Range(.Cells(2, columnReference), .Cells(4, columnReference)).Value
    End With
End Sub

CodePudding user response：

Populate Combo Box Based On Selection in Another Combo Box

UserForm e.g. UserForm1 (careful)

Private Sub UserForm_Initialize()
    ComboBox2.List = Array("17", "19", "21", "23", "25", "25 ")
End Sub

Private Sub ComboBox2_Change()

    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.Worksheets("SUPPLY_TO_PRODUCTION")
    Dim arg As Range: Set arg = ws.Range("T6:T1000," _
        & "V6:V1000,X6:X1000,Z6:Z1000,AB6:AB1000,AD6:AD1000")
        
    Dim aIndex As Long: aIndex = ComboBox2.ListIndex   1 ' zero-based
    
    Dim Data() As Variant: Data = GetColumnRange(arg.Areas(aIndex))
    Dim dict As Object: Set dict = DictColumn(Data)
    If dict Is Nothing Then Exit Sub
    ComboBox1.List = dict.Keys
    
End Sub

Standard Module e.g. Module1

Function GetColumnRange( _
    ByVal rg As Range, _
    Optional ByVal ColumnNumber As Long = 1) _
As Variant
    If rg Is Nothing Then Exit Function
    If ColumnNumber < 1 Then Exit Function
    If ColumnNumber > rg.Columns.Count Then Exit Function
    
    With rg.Columns(ColumnNumber)
        If rg.Rows.Count = 1 Then
            Dim Data As Variant: ReDim Data(1 To 1, 1 To 1): Data(1, 1) = .Value
            GetColumnRange = Data
        Else
            GetColumnRange = .Value
        End If
    End With

End Function

Function DictColumn( _
    ByVal Data As Variant, _
    Optional ByVal ColumnIndex As Variant) _
As Object
    Const ProcName As String = "DictColumn"
    On Error GoTo ClearError
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare ' case-insensitive
    
    Dim c As Long
    
    If IsMissing(ColumnIndex) Then
       c = LBound(Data, 2) ' use first column Index2
    Else
       c = CLng(ColumnIndex)
    End If
    
    Dim Key As Variant
    Dim r As Long
    
    For r = LBound(Data, 1) To UBound(Data, 1)
        Key = Data(r, c)
        If Not IsError(Key) Then ' exclude error values
            If Len(CStr(Key)) > 0 Then ' exclude blanks
                dict(Key) = Empty
            End If
        End If
    Next r
   
    If dict.Count = 0 Then Exit Function ' only error values and blanks
    
    Set DictColumn = dict

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function