none
Excel 2016 VBA ComboBox - How to get unique values to display from a data worksheet? RRS feed

  • Question

  • This is the code that loads the combobox when the form is initialized:

    Private Sub prComboBoxFill3()
        TRows = Worksheets("Data").Range("A1").CurrentRegion.Rows.Count
        ComboBoxLocation.Clear
        For i = 2 To TRows
            ComboBoxLocation.AddItem Worksheets("Data").Cells(i, 4).Value
        Next i
    End Sub

    For example, on the form below I need to see unique values in the dropdown for location. Can someone help me with the syntax to do that?

    Thank you,

    Karen

    Thursday, March 2, 2017 11:24 PM

Answers

  • Here's a little more info regarding Scripting.Dictionaries so you can get the 'Intellisense' view of things. I'll add a re-write of Deepak's code so you might see a little more of what's going on.To get the intellisense working and confirm that indeed you have code that works, add a reference to Microsoft Scripting Runtime. To do this, click on Tools/References in the VB editor's menu and put a checkbox in the Microsoft Scripting Runtime as shown:

    This little gem contains the Scripting.Dictionary among other helpful classes. Once you have that, you can create the Scripting Dictionary as shown in the re-write below:

    Private Sub prComboBoxFill3()
         Dim dEntries As Scripting.Dictionary
         Dim wksTarget As Excel.Worksheet
         Dim rngMyItems As Excel.Range
         Dim rngThisCell As Excel.Range
         
         On Error Resume Next
         
         Set wksTarget = Excel.ThisWorkbook.Worksheets("Data")
         Set dEntries = New Scripting.Dictionary
         dEntries.CompareMode = TextCompare            ' Case InSensitive! so "Blue = blue"
         Set rngMyItems = wksTarget.Range("D2")
         ' Resize the range from one cell to all of those used in Column D,
         ' then the range with your selections is referenced in the variable rngMyItems:
         '  > For Rows, '-1' is because we are Resizing and starting @ Row 2.
         '  > Using Column 4 because that's Column 'D' -> Where your selection data is
         Set rngMyItems = rngMyItems.Resize(wksTarget.Cells(Rows.Count, 4).End(xlUp).Row - 1, 1)
         For Each rngThisCell In rngMyItems.Cells()
            If rngThisCell.Value <> "" Then dEntries(rngThisCell.Value) = 1     ' the 1 is just a placeholder
         Next rngThisCell
         MsgBox "Debug> Entries" & vbCrLf & Join(dEntries.Keys, vbCrLf)     ' Comment this line out - helpful for debug
         Me("ComboBoxLocation").List = dEntries.Keys   ' Keys is a 1-dimensional array of the KeyValues
         Set dEntries = Nothing         ' These do a little cleanup
         Set rngThisCell = Nothing
         Set rngMyItems = Nothing
      End Sub
    

    Hope this takes a bit less than a couple years to get through!


    -MainSleuth You've Got It, Use It! Engineering, Science, Statistics Solutions http://ToolSleuth.com. For any reply that either helps to answer your question or is the answer, please mark it as helpful or as the answer so others with the same question will have an answer quickly.

    • Marked as answer by Karenola888 Friday, March 3, 2017 5:30 PM
    Friday, March 3, 2017 3:21 PM

All replies

  • Hi Karenola888,

    you can try to use code below.

    Private Sub UserForm_Activate()
    Dim d As Object, c As Variant, i As Long, lr As Long
    Set d = CreateObject("Scripting.Dictionary")
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    c = Range("A2:A" & lr)
    For i = 1 To UBound(c, 1)
      d(c(i, 1)) = 1
    Next i
    Me("ComboBox1").List = d.Keys
    End Sub

    Output:

    you can see there is duplicate values in column A1, but only unique values in combobox.

    Regards

    Deepak


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Friday, March 3, 2017 1:34 AM
    Moderator
  • Hi Deepak,

    Thank you for your reply - I am trying to understand it. I looked up scripting.dictionary to understand better what that is doing. If I understood it correctly, that is reading the list like an array? I'm using a Sub UserForm_Initialize and so read up on what the difference is between initialize and activate.  I have a better understanding there. However, I'm not sure how to get the code above to look at the column in the "Data" worksheet.  I tried adding the code to this sub routine, but I'm missing something because the box is blank. I used to lightly code VBA about 15 years ago and now I'm getting back on that horse. So much to learn! If I call this sub in the UserForm_Activate - shouldn't it fill the box when the form opens?

    Private Sub prComboBoxFill3()
        Dim d As Object, c As Variant, i As Long, lr As Long
        TRows = Worksheets("Data").Range("D1")
        Set d = CreateObject("Scripting.Dictionary")
        lr = Cells(Rows.Count, 1).End(xlUp).Row
        c = Range("D2:D" & lr)
        For i = 1 To UBound(c, 1)
        d(c(i, 1)) = 1
        Next i
        Me("ComboBoxLocation").List = d.Keys
     End Sub
    Friday, March 3, 2017 1:53 PM
  • Hi Karenola888 -

    Scripting.Dictionary is a specialized collection of Key/Value pairs - so like arrays but with a little extra power.  For example, you do not have to dimension the 'array' and the dictionary automatically grows when the intended key doesn't already exist. If it does, then it simply overwrites the old value with the new value.

    The 'array' locations are addressable by the Key and the Key must be unique; that is what Deepak's code is leveraging. The syntax in the example is d(<KeyValue>) = Value.

    The variable, c, is a 2 dimensional array, c(row#, Column#) that contains all of the values found in the range D1:D<LastRowInWorksheet>, where <LastRowInWorksheet> is found by the construct "Cells(Rows.Count, 1).End(xlUp).Row", which usually gives the same result as your "Worksheets("Data").Range("A1").CurrentRegion.Rows.Count". The former allows for the column to have data in fewer rows - a 'ragged' edge to the UsedRange property; I don't recall the correlation to CurrentRegion.

    <oops> Missed your offset of cells(i,4)... That's why Deepak used Column 'D'...


    -MainSleuth You've Got It, Use It! Engineering, Science, Statistics Solutions http://ToolSleuth.com. For any reply that either helps to answer your question or is the answer, please mark it as helpful or as the answer so others with the same question will have an answer quickly.



    • Edited by MainSleuth Friday, March 3, 2017 2:53 PM
    Friday, March 3, 2017 2:41 PM
  • Good and appreciated explanations! Thank you MainSleuth. Right now it feels like it will take me 2 years to get this form working. :)  But I WILL get it.  And the help you experts give is what makes it possible.  I suspect my problem may not be (at least only) in this sub routine. I'll keep at it. Thanks again!
    Friday, March 3, 2017 3:05 PM
  • Here's a little more info regarding Scripting.Dictionaries so you can get the 'Intellisense' view of things. I'll add a re-write of Deepak's code so you might see a little more of what's going on.To get the intellisense working and confirm that indeed you have code that works, add a reference to Microsoft Scripting Runtime. To do this, click on Tools/References in the VB editor's menu and put a checkbox in the Microsoft Scripting Runtime as shown:

    This little gem contains the Scripting.Dictionary among other helpful classes. Once you have that, you can create the Scripting Dictionary as shown in the re-write below:

    Private Sub prComboBoxFill3()
         Dim dEntries As Scripting.Dictionary
         Dim wksTarget As Excel.Worksheet
         Dim rngMyItems As Excel.Range
         Dim rngThisCell As Excel.Range
         
         On Error Resume Next
         
         Set wksTarget = Excel.ThisWorkbook.Worksheets("Data")
         Set dEntries = New Scripting.Dictionary
         dEntries.CompareMode = TextCompare            ' Case InSensitive! so "Blue = blue"
         Set rngMyItems = wksTarget.Range("D2")
         ' Resize the range from one cell to all of those used in Column D,
         ' then the range with your selections is referenced in the variable rngMyItems:
         '  > For Rows, '-1' is because we are Resizing and starting @ Row 2.
         '  > Using Column 4 because that's Column 'D' -> Where your selection data is
         Set rngMyItems = rngMyItems.Resize(wksTarget.Cells(Rows.Count, 4).End(xlUp).Row - 1, 1)
         For Each rngThisCell In rngMyItems.Cells()
            If rngThisCell.Value <> "" Then dEntries(rngThisCell.Value) = 1     ' the 1 is just a placeholder
         Next rngThisCell
         MsgBox "Debug> Entries" & vbCrLf & Join(dEntries.Keys, vbCrLf)     ' Comment this line out - helpful for debug
         Me("ComboBoxLocation").List = dEntries.Keys   ' Keys is a 1-dimensional array of the KeyValues
         Set dEntries = Nothing         ' These do a little cleanup
         Set rngThisCell = Nothing
         Set rngMyItems = Nothing
      End Sub
    

    Hope this takes a bit less than a couple years to get through!


    -MainSleuth You've Got It, Use It! Engineering, Science, Statistics Solutions http://ToolSleuth.com. For any reply that either helps to answer your question or is the answer, please mark it as helpful or as the answer so others with the same question will have an answer quickly.

    • Marked as answer by Karenola888 Friday, March 3, 2017 5:30 PM
    Friday, March 3, 2017 3:21 PM
  • Me too! I tried the code and saw it work once. I don't know what happened but I can't make it work again. I filled out a contact form on your website.
    Friday, March 3, 2017 4:55 PM
  • Oh! I must have deleted this line by mistake:      Me("ComboBoxLocation").List = dEntries.Keys

    It's rather important if I want to see results.  Sorry - that was the problem and it is working.  Thank you!!!

    Friday, March 3, 2017 5:08 PM
  • Good to hear it's working & even better that you found what the issue was!

    In the meantime... meetings seem to wait for nobody


    -MainSleuth You've Got It, Use It! Engineering, Science, Statistics Solutions http://ToolSleuth.com. For any reply that either helps to answer your question or is the answer, please mark it as helpful or as the answer so others with the same question will have an answer quickly.

    Friday, March 3, 2017 8:57 PM