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!
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
请试试这个:
ws.Shapes("dropdown_row" & TC.Row).OLEFormat.Object.List = myArray
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.