Populate form control Drop Down Box with unique value

[vck2017]

hi, I am trying to populate a drop down box with a column of dates and only want to populate unique values. I have tried the following code but it doesn't work. Can anyone please assist?

Sub FilterUniqueData()​

Dim Lrow As Long, test As New Collection​

Dim Value As Variant, temp() As Variant​

ReDim temp(0)​

​

On Error Resume Next​

With ActiveSheet​

Lrow = .Range("C" & Rows.Count).End(xlUp).Row​

temp = .Range("C10:C" & Lrow).Value​

End With​

​

For Each Value In temp​

If Len(Value) > 0 Then test.Add Value, CStr(Value)​

Next Value​

​

ActiveSheet.Shapes("Drop Down 6").ControlFormat.RemoveAllItems​

​

For Each Value In test​

ActiveSheet.Shapes("Drop Down 6").ControlFormat.AddItem Value​

Next Value​

​

Set test = Nothing​

​

End Sub​

 

[wideboydixon]

I think you need to check whether the value is already in the collection before adding it. Untested but perhaps something like this:

Sub FilterUniqueData()

Dim Lrow As Long, test As New Collection
Dim Value As Variant, temp() As Variant
Dim testVal As Variant
ReDim temp(0)

On Error Resume Next
With ActiveSheet
    Lrow = .Range("C" & Rows.Count).End(xlUp).Row
    temp = .Range("C10:C" & Lrow).Value
End With

For Each Value In temp
    If Len(Value) > 0 Then
        Err.Clear
        testVal = test.Item(CStr(Value))
        If Err.Number <> 0 Then test.Add Value, CStr(Value)
    End If
Next Value

ActiveSheet.Shapes("Drop Down 6").ControlFormat.RemoveAllItems
For Each Value In test
    ActiveSheet.Shapes("Drop Down 6").ControlFormat.AddItem Value
Next Value
Set test = Nothing

End Sub

WBD

 

[vck2017]

Thanks, but still can't make it work. Do I need to initialize the drop down box somehow? The range of data in column C consists of dates, could that cause a problem?

 

[wideboydixon]

So your dates start at C10 and run down the column? I set up a quick test and the code posted works on my sheet. What do you mean by "can't make it work"?

WBD