Removes duplicates from dropdown list combobox

Option Explicit


Private Sub PopulateComboBox()


  Dim varColItem  As Variant
  Dim colListData  As Collection


    With Me.ComboBox1
      Set colListData = DeDuplicate(Range("AccountsList"))
      For Each varColItem In colListData
        .AddItem varColItem.Value2
      Next varColItem
    End With


    'Clean up
    Set varColItem = Nothing
    Set colListData = Nothing
   
End Sub


'Pass in the single dimension range and this will only add the unique items into a collection to be passed back to the calling code
Public Function DeDuplicate(ByRef rngInputRange As Range) As Collection


  Dim colTempCollection As Collection
  Dim varWrkCell        As Variant
 
    Set colTempCollection = New Collection
    For Each varWrkCell In rngInputRange
      If IsInCollection(colTempCollection, Trim(CStr(varWrkCell.Value2))) = False Then
        colTempCollection.Add varWrkCell, Trim(CStr(varWrkCell.Value2))
      End If
    Next varWrkCell
   
    Set DeDuplicate = colTempCollection
   
    'Clean up
    Set colTempCollection = Nothing
    Set varWrkCell = Nothing
   
End Function


'Evaluates whether the item is currently in the collection or not
Private Function IsInCollection(ByRef colTempCollection As Collection, ByRef strItemKey As String)


Dim varTempItem As Variant


On Error GoTo ErrHandler


'If the object can't be set then it isn't currently in the collection (i.e. it's unique)
Set varTempItem = colTempCollection.Item(strItemKey)
IsInCollection = True
GoTo ExitHandler


ErrHandler:
IsInCollection = False


ExitHandler:
'Clean up
Set varTempItem = Nothing


End Function

Private IsArrow As Boolean
Option Explicit
Dim MyArray
Private Sub ComboBox1_Change()
Dim i As Long
    With Me.ComboBox1
       If Not IsArrow Then .List = MyArray 'Range("AccountsList").Value
        If .ListIndex = -1 And Len(.Text) Then
            For i = .ListCount - 1 To 0 Step -1
                If InStr(1, .List(i), .Text, 1) = 0 Then .RemoveItem i
            Next i
            .DropDown
        End If
    End With
End Sub


Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    IsArrow = KeyCode = vbKeyUp Or KeyCode = vbKeyDown
    If KeyCode = vbKeyReturn Then Me.ComboBox1.List = MyArray 'Range("AccountsList").Value
End Sub
Private Sub UserForm_Initialize()
    Dim db
    With CreateObject("scripting.dictionary")
        For Each db In Range("AccountsList").Value
            If Not .exists(db) Then
                .Add db, db
            End If
        Next
        MyArray = .keys
    End With
End Sub