Avoid duplicates in a listbox populated from multiple ranges using search keyword

[sivakumar123]

Hi,

I have a listbox which is populated from multiple ranges by using keyword search. I want to avoid duplicates in the search result.
Listbox name : Members
Ranges : teamRng and nameRng
Following is the code i use :

Private Sub searchBox_Change()
Dim cellName As Range, nameRng As Range, firstName As String
Dim cellTeam As Range, teamRng As Range, firstTeam As String, myCell As String

ContactForm.Members.Clear
Set [B]nameRng [/B]= ContactWorkBook.ActiveSheet.Range("myName")
Set [B]teamRng [/B]= ContactWorkBook.ActiveSheet.Range("teamName")

Set cellName = nameRng.Find(What:=searchBox.Value & "*", After:=nameRng(nameRng.Count), LookIn:=xlValues, _
                            Lookat:=xlWhole, SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, MatchCase:=False)
                            
Set cellTeam = teamRng.Find(What:=searchBox.Value & "*", After:=teamRng(teamRng.Count), LookIn:=xlValues, _
                            Lookat:=xlWhole, SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, MatchCase:=False)

[I]'To populate Member Names[/I]
If Not cellName Is Nothing Then
   firstName = cellName.Address
   Do
     With Members
     .AddItem cellName
     .List(.ListCount - 1, 1) = cellName
     If searchBox.Value = "" Then
        .Clear
     End If
     End With
   Set cellName = nameRng.FindNext(After:=cellName)
   Loop While cellName.Address <> firstName
End If


[I]'To populate Team Names[/I]
[COLOR=#ff0000]Dim sFound As Boolean, i As Integer
sFound = False
If Not cellTeam Is Nothing Then
   For i = 0 To Members.ListCount - 1
      If cellTeam = Members.List(i) Then
         sFound = True
      End If
   Next
   If Not sFound Then
      firstTeam = cellTeam.Address
      Do
        myCell = cellTeam.Value
        With Members
          .AddItem cellTeam
          .List(.ListCount - 1, 1) = cellTeam
          If searchBox.Value = "" Then
          .Clear
          End If
        End With
      Set cellTeam = teamRng.FindNext(After:=cellTeam)
      MsgBox myCell
      Loop While cellTeam.Address <> firstTeam And cellTeam <> myCell
   End If
End If
[/COLOR]
Call sortList
End Sub

The code in red color is a result of lot of tweaking.
This is where I was failed to remove duplicates. It worked partially though.

Kindly help me out on removing duplicates from the listbox.

Best Regards
Sivakumar

 

[sivakumar123]

Since this was not answered for sometime, I have posted the question, in a more readable way, in another forum. PFB the link.
Avoid duplicates in a listbox populated using search keyword