locked
Dependent combox in Userform to return values from several adjacent columns in a record RRS feed

  • Question

  • Hi, I have posted this thread before, however may have not explained clearly what I wanted to do. To simplify, I have a dynamic table in Excel which has 6 columns - say A-F.  I want to use the userform to select a value from Column A (using combobox 1) , then use a dependent combobox (combobox2) to select a value from Column B which is dependant on the value selected in Combobox 1. I also want the values in columns C,D,E and F that are adjacent to the selected value in Column B to be automatically added to  textboxes that are also on the Userform. In summary, the value selected in the dependant combobox (combobox 2) also selects the adjacent values for the same row in columns C,D,E and F.

    I already have code that works for selecting values from Column A using combobox 1 and then populates combobox 2 with values from Column 2, depending on what was selected in Combobox 1. What I can't get it to do is populate the 4 textboxes with the correct values.

    Can anyone help me ?- I'm sure there's a way of doing this. The code I have is below:

    Option Explicit
    Option Base 1

    Private Sub UserForm_Initialize()
      CboArea.List() = [AreaList].Value
      CboSpecies.List() = [AreaSpecies].Value
       CboSpecies.BoundColumn = 2
       CboSpecies.ColumnCount = 2
       CboSpecies.ColumnWidths = "0 cm; 2 cm"
     End Sub
     
        Private Sub CboArea_Change()
       Dim arrFilter() As Variant
       Dim arrInp() As Variant
       Dim i As Long, j As Long
       With [AreaSpecies]
         ReDim arrInp(.Rows.Count, 2)
         arrInp = .Value
       End With
     
      j = 1
       For i = 1 To UBound(arrInp, 1)
         If arrInp(i, 1) = CboArea.Value Then
           j = j + 1
         End If
       Next i
       ReDim arrFilter(j - 1, 2)
      
       j = 1
       For i = 1 To UBound(arrInp, 1)
         If arrInp(i, 1) = CboArea.Value Then
           arrFilter(j, 1) = arrInp(i, 1)
           arrFilter(j, 2) = arrInp(i, 2)
           j = j + 1
         End If
       Next i
      
       Dim temp_array() As Variant
      
       Dim n As Integer
        ReDim temp_array(j - 1)
       For n = 1 To j - 1
        temp_array(n) = arrFilter(n, 2)
       Next
       CboSpecies.List() = temp_array
       CboSpecies.List = arrFilter()
       CboSpecies.BoundColumn = 2
       CboSpecies.ColumnCount = 2
       CboSpecies.ColumnWidths = "0 cm; 2 cm"
       
    End Sub

    Private Sub CboSpecies_Change()
        TxtFamily.Value = CStr(Sheets("MasterList").Range("C" & CboSpecies.ListIndex + 2))
        TxtCommonName.Value = CStr(Sheets("MasterList").Range("D" & CboSpecies.ListIndex + 2))
        TxtGrid.Value = CStr(Sheets("MasterList").Range("E" & CboSpecies.ListIndex + 2))
        TxtComments.Value = CStr(Sheets("MasterList").Range("F" & CboSpecies.ListIndex + 2))
           
     End Sub

    Private Sub BtnAddToPOIList_Click()
    Dim emptyRow As Long

    'Make Sheet1 Active
    Sheets("PlantsOfInterest").Activate

    'Determine EmptyRow
    emptyRow = WorksheetFunction.CountA(Range("B:B")) + 1

    'Export Data to worksheet
    Cells(emptyRow, 2).Value = CboArea.Value
    Cells(emptyRow, 3).Value = CboSpecies.Value
    Cells(emptyRow, 4).Value = TxtFamily.Value
    Cells(emptyRow, 5).Value = TxtCommonName.Value
    Cells(emptyRow, 6).Value = TxtGrid.Value
    Cells(emptyRow, 7).Value = TxtComments.Value
    End Sub

    Private Sub BtnCloseForm_Click()
    Unload Me
    End Sub

     My Table looks like this:

    Area (column A) Species (B) Family (C) Common Name (D) Grid (E) Comments (F)

    Australian Plant Communities

    Acacia crassicarpa Mimosaceae Northern Wattle S28 Hello
    Australian Plant Communities Acacia decora Mimosaceae Western/Pretty Wattle Q39  Hello
    Deserts Acacia decurrens Mimosaceae Green Wattle, Early Black Wattle S28 Hello
    Deserts Acacia elata Mimosaceae Cedar Wattle N40, R29 Hello
    Rainforests Acacia falcata Mimosaceae Hickory Wattle P31 Hello
    Rainforests Acacia fimbriata Mimosaceae Brisbane Wattle P30, S26 Hello
    Rainforests Acacia floribunda Mimosaceae River Wattle, Catkin Wattle R26 Hello

    • Moved by Max Meng Wednesday, May 23, 2012 3:12 AM Moving to a more appropriate forum (From:Office IT Pro General Discussions)
    • Moved by Bob Wu-MT Thursday, May 24, 2012 5:58 AM VBA issue (From:Windows Forms Designer)
    Tuesday, May 22, 2012 11:24 AM

All replies

  • Hi chuxtable,

    According to your description, the issue is related to VBA. I will move it to the VBA Forum for better support.

    Sorry for any inconvenience this may cause.

    Best Regards,


    Bob Wu [MSFT]
    MSDN Community Support | Feedback to us

    Thursday, May 24, 2012 5:57 AM
  • Bob, where did you put it? I searched the VBA forum and couldn't find it!!!
    Thursday, May 24, 2012 3:29 PM
  • Hi chuxtable,

    The current forum is the VBA forum.

    Best Regards,


    Bob Wu [MSFT]
    MSDN Community Support | Feedback to us

    Friday, May 25, 2012 1:44 AM