Excel VBA：将数组添加到表单控件组合框

Question

I have several files I want to combine and analyse with one results file. One of those files contains samples with different names that are repeated an unknown amount of times. I want to extact all unknown names from this file and add them to a dropdown box (Form Control Combobox).

To simplify things I added the following strings to the first column a sheet in a new Excel file:

String 1

String 1

String 2

String 3

String 3

String 3

String 4

String 4

to extract the unique strings, I wrote the following piece of code:

Sub MakeArrayInDropDown()
    ' Declare variables
    Dim myArray() As Variant    ' Array with undefined size
    Dim i As Integer            ' Counter for-loop
    Dim i_UnStr As Integer      ' Counter of unique strings
    Dim i_lastStr As Integer    ' Length of strings in column A
    Dim wb As Workbook          ' Short workbookname
    Dim ws As Worksheet         ' Short worksheet name
    Dim TC As Range             ' Target Cell (TC)

    ' Set workbook and worksheet
    Set wb = ThisWorkbook
    Set ws = ActiveSheet

    ' Set cell where all unique strings should go to
    Set TC = ws.Cells(1, 3)

    ' Determine amount of strings in column A
    i_lastStr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    ' Go through all strings that are in column A
    For i = 1 To i_lastStr

        ' Save the first string in the first position of the array
        If i_UnStr = 0 Then
            i_UnStr = 1
            ReDim myArray(i_UnStr)                      ' Resize array to 1
            myArray(i_UnStr) = ws.Cells(i, 1)           ' Add first string to array

        ' Add if next string is different from the string previously added
        ElseIf Not StrComp(myArray(i_UnStr), ws.Cells(i, 1)) = 0 Then
            ' Increase unique strings counter
            i_UnStr = i_UnStr + 1
            ' Resize array to no unique strings, preserving precious values
            ReDim Preserve myArray(i_UnStr)
            ' Add next unique string to array as well
            myArray(i_UnStr) = ws.Cells(i, 1)
        End If
    Next i

    ' Add Form Control dropdown to target cell
    ws.DropDowns.Add(TC.Left, TC.Top, TC.Width, TC.Height).Name = "dropdown_row" & TC.Row
    wb.Worksheets("Sheet1").Shapes("dropdown_row" & TC.Row).ControlFormat.List = myArray
End Sub

Unfortunately, this code results in the following error:

Runtime error 1004: Unable to set the List property of the Dropdown class

I don't understand what is wrong withmy array, because if I change the last line into

wb.Worksheets("Sheet1").Shapes("dropdown_row" & TC.Row).ControlFormat.List = _
    Array(myArray(1), myArray(2), myArray(3), myArray(4))

Everything works perfectly fine. It seems like my array is not accepted as such...

Also, initially I wrote the last line like this

ws.Shapes("dropdown_row" & TC.Row).ControlFormat.List = myArray

But that gave me:

Runtime error 424: object required

Can anybody explain me why any of these two things are wrong? Thanks a lot!

Answer 1

I've tested your code and my observations as follows:

The DropDown shape does not like the Empty value at index 0 of your array. It seems that you are not able to use mixed type in the array you're passing to the .List method, because even if I change the Empty value to an integer, it fails with the same error.

Regarding why this statement works:

 wb.Worksheets("Sheet1").Shapes("dropdown_row" & TC.Row).ControlFormat.List = _ Array(myArray(1), myArray(2), myArray(3), myArray(4))

The above works because you're passing an array that avoids the pitfall mentioned above, because you're explicitly not passing the Empty value.

Note: Strictly speaking, there is no need for you to ReDim your array when i_UnStr = 0 , arrays are normally base 0, so you can just work with it that way.

Alternatively, you can force a null string in to the first array item, and this should work:

myArray(0) = vbNullString
ws.Shapes("dropdown_row" & TC.Row).ControlFormat.List = myArray

So, the solution is to avoid mixed data type (and possibly also the unnecessary empty element in the array), or if you need a "blank", you need to assign it as an empty string either vbNullString or literal "" .

In terms of optimisation, I'd avoid the array altogether especially if the data is large, because ReDim Preserve is usually a rather expensive statement.

Sub MakeArrayInDropDown()
    ' Declare variables
    Dim i As Integer            ' Counter for-loop
    Dim i_lastStr As Integer    ' Length of strings in column A
    Dim wb As Workbook          ' Short workbookname
    Dim ws As Worksheet         ' Short worksheet name
    Dim TC As Range             ' Target Cell (TC)
    Dim DD As Shape             ' Dropdown shape
    ' Set workbook and worksheet
    Set wb = ThisWorkbook
    Set ws = ActiveSheet

    ' Set cell where all unique strings should go to
    Set TC = ws.Cells(1, 3)

    ' Determine amount of strings in column A
    i_lastStr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    ' Add Form Control dropdown to target cell
    Set DD = ws.DropDowns.Add(TC.Left, TC.Top, TC.Width, TC.Height)
    DD.Name = "dropdown_row" & TC.Row
    DD.AddItem ""  'Adds a blank entry in the first row of the dropdown
    DD.AddItem ws.Cells(i,1).Value
    For i = 2 To i_lastStr
        ' Add if next string is different from the string previously added
        ElseIf Not StrComp(ws.Cells(i-1, 1), ws.Cells(i, 1)) = 0 Then
            DD.AddItem ws.Cells(i, 1).Value
        End If
    Next i

End Sub

Answer 2

请试试这个：

ws.Shapes("dropdown_row" & TC.Row).OLEFormat.Object.List = myArray