使用工作表VBA Excel中的每个值仅创建一个组合框

Question

I am trying to create a combobox with contains data from a worksheet. I have code that does this but what I need is to only show one of every value in a given column. For example in column AI have multiple dogs,cats and fish, what I want the combobox to show is a list of 3 which is dog,cats,fish. How do I get it to stop showing dog,dog,dog,cat,cat,fish,fish,fish,fish for example. Below is the code that I am currently using.

    With Worksheets("RuleID")
    OriginatingDomainComboBox.List = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).row).value
    End With

Any help would be great and if there is anything else you might need to now let me know.

thanks

Answer 1

Here is the method to complete this task:

Public Sub loadValues()
    Dim lastRow As Long
    Dim rng As Excel.Range
    Dim rawData As Variant
    Dim columnItems() As String
    Dim arraySize As Integer
    Dim i As Long
    Dim uniqueItems() As Variant
    '-------------------------------------------------------------------


    'Find data range
    With Worksheets(1)
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set rng = .Range(.Cells(1, 1), .Cells(lastRow, 1))
    End With


    'Get data from worksheet.
    rawData = rng   '<-- for better performance we assign all the data to
                    '    Variant array and we iterate through this array
                    '    later instead of iterating through worksheet's cells


    'Convert rawData array to 1D array of strings.
    arraySize = UBound(rawData, 1) - LBound(rawData, 1) + 1
    ReDim columnItems(1 To arraySize)
    For i = LBound(columnItems) To UBound(columnItems)
        columnItems(i) = rawData(i, 1)
    Next i


    'Get unique values from [columnItems] array by using function [uniqueValues].
    uniqueItems = uniqueValues(columnItems)


    'Assign array of unique values as a list to ComboBox.
    cmbTest.List = uniqueItems


End Sub

In order to make this method work properly, you need to include the function to get unique values from the given array .

Answer 2

Further to @mielk's answer, you could also use a dictionary to accomplish what you're after.

The below uses the 'Microsoft Scripting Runtime' reference. Remember to enable this within Tools -> References.

Option Explicit
Sub populateUF()
    Dim dict As Scripting.Dictionary, myItem As Variant
    Dim lrow As Long, i As Long
    Dim myValues() As Variant

    Set dict = New Scripting.Dictionary
    lrow = Cells(Rows.Count, 1).End(xlUp).Row
    myValues = Range(Cells(2, 1), Cells(lrow, 1))
    For i = 1 To UBound(myValues, 1)
        If Not dict.Exists("Item" & myValues(i, 1)) Then
            dict.Item("Item" & myValues(i, 1)) = myValues(i, 1)
        End If
    Next i

    For Each myItem In dict
        UserForm1.ComboBox1.AddItem dict.Item(myItem)
    Next myItem

    UserForm1.Show
End Sub

We are using the .Exists method to assess whether or not the value from the array has previously been added to the dictionary. New values are added to the dictionary, resulting in only unique values from the array being assigned. We then iterate through the dictionary using the for each statement, assigning values to the combobox.

For further reading on dictionaries, see the documentation here , and in more detail here .