Remove Duplicates From ComboBox

[Ricky1]

Ok my combo boxes get filled using a database on formload.

Is there a way to see if something is already in the combo box therefore not adding it again ? (Assuming this would be slow?)

or does anyone have a quick function to remove duplicates?

[MWagner]

Just have a simple function like this..

Private Function CheckForDupe(sItem As String) As Boolean
   Dim i as Integer
   
   CheckForDupe = False
 
   For i = 0 to ComboBox1.ListCount - 1
       If ComboBox1.List(i) = sItem 'You might want to do " If LCase(ComboBox1.List(i)) = LCase(sItem)
           CheckForDupe = True
           Exit For
       End If
   Next i

Then just before you add an item to a combobox, do..

If CheckForDupe(item) = False Then
    'Add the item
End If

[Mark Gambo]

Ok my combo boxes get filled using a database on formload.

Is there a way to see if something is already in the combo box therefore not adding it again ? (Assuming this would be slow?)

or does anyone have a quick function to remove duplicates?

Why not prevent them when you are loading them from the Database?

Post your SQL String I bet that if you add Group By to it it will probably eliminate all duplicates

[bushmobile]

using the API to find dupes in a listbox is faster than looping:

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
    ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
 
Private Const CB_FINDSTRINGEXACT = &H158
 
Private Function IsDupe(ByVal sItem As String) As Boolean
    IsDupe = (SendMessage(Combo1.hWnd, CB_FINDSTRINGEXACT, -1&, ByVal sItem) > -1)
End Function

[Ricky1]

Public Sub FillStatCombos()

rs.MoveFirst
    Do Until rs.EOF = True
        Combo1.AddItem rs.Fields("Type")
        Combo2.AddItem rs.Fields("Entry")
        Combo3.AddItem rs.Fields("Entrants")
        rs.MoveNext
    Loop

End Sub

is what i use to fill the combo boxes mark.




bush does that work for a combobox ? coz u have list there.

[bushmobile]

whoops, sorry - yes it does work with a combobox, it's just a different constant.

I have ammended the code in post #4 accordingly

[Ricky1]

Ok and combo1 is the name of the combo box right??

What is sItem?

[bushmobile]

well given your current code, try it like this:

Private Function IsDupe(ByVal cbo As ComboBox, ByVal sItem As String) As Boolean
    IsDupe = (SendMessage(cbo.hWnd, CB_FINDSTRINGEXACT, -1&, ByVal sItem) > -1)
End Function
 
Public Sub FillStatCombos()
    rs.MoveFirst
    Do Until rs.EOF
        If Not IsDupe(Combo1, rs.Fields("Type")) Then Combo1.AddItem rs.Fields("Type")
        If Not IsDupe(Combo2, rs.Fields("Entry")) Then Combo2.AddItem rs.Fields("Entry")
        If Not IsDupe(Combo3, rs.Fields("Entrants")) Then Combo3.AddItem rs.Fields("Entrants")
        rs.MoveNext
    Loop
End Sub

[Merri]

There is also another technique you can use: make a string which contains all the combobox items separated by a null character. Before adding a new item you can make a simple and fast InStr check to see if the value exists already in the combobox.

Option Explicit
 
Dim strComboItems As String
 
Private Sub AddCombo(ByRef Item As String)
    ' make sure the combo items string has atleast a null character
    ' it will remain as the first character in the string at all times
    If LenB(strComboItems) = 0 Then strComboItems = vbNullChar
    ' check if item already found
    If InStr(strComboItems, vbNullChar & Item & vbNullChar) > 0 Then Exit Sub
    ' it was not found, add it in
    Combo1.AddItem Item
    ' and into the string too, so the checking works
    strComboItems = strComboItems & Item & vbNullChar
End Sub
Private Sub ClearCombo()
    strComboItems = vbNullChar
    Combo1.Clear
End Sub
Private Sub RemoveCombo(ByVal Index As Integer)
    Dim lngA As Long
    ' validate index
    If Index < 0 Or Index >= Combo1.ListCount Then Exit Sub
    lngA = InStr(strComboItems, vbNullChar & Combo1.List(Index) & vbNullChar)
    strComboItems = Left$(strComboItems, lngA) & Right$(strComboItems, Len(strComboItems) - lngA - Len(Combo1.List(Index)) - 1)
    Combo1.RemoveItem Index
End Sub
Private Sub Form_Load()
    AddCombo "laa"
    AddCombo "laa2"
    RemoveCombo 0
    AddCombo "laa2"
    AddCombo "laa"
    Combo1.ListIndex = 0
End Sub

I don't know how this compares against the API call; if there are a lot of duplicates, this might work faster, but if there are almost no duplicates, then this might be slower. But this certainly requires more code, no way around that. Although this can be optimized for speed if the need be, which is something you can't do with an API call

[Comintern]

Why not prevent them when you are loading them from the Database?

Post your SQL String I bet that if you add Group By to it it will probably eliminate all duplicates

I couldn't agree more. The easiest way I've found to do this is to just query for one field at a time with the DISTINCT keyword:

Public Sub FillStatCombos()
 
    Dim oTemp As ADODB.Recordset, sSQL As String
    
    sSQL = "SELECT DISTINCT Type FROM Table;"   'Table is the DB table for the records.
    Set oTemp = GetRecords(sSQL)
    If Not oTemp Is Nothing Then
        FillCombo oTemp, Combo1
    End If
    oTemp.Close
    
    sSQL = "SELECT DISTINCT Entry FROM Table;"
    Set oTemp = GetRecords(sSQL)
    If Not oTemp Is Nothing Then
        FillCombo oTemp, Combo2
    End If
    oTemp.Close
    
    sSQL = "SELECT DISTINCT Entrants FROM Table;"
    Set oTemp = GetRecords(sSQL)
    If Not oTemp Is Nothing Then
        FillCombo oTemp, Combo3
    End If
    oTemp.Close
 
    Set oTemp = Nothing
 
End Sub
 
Private Sub FillCombo(oRecords As ADODB.Recordset, oCombo As Object)
    
    Dim sTemp As String
 
    With oRecords
        Do Until .EOF
            sTemp = .Fields(1).Value & vbNullString
            If Len(sTemp) <> 0 Then
                oCombo.AddItem sTemp
            End If
            .MoveNext
        Loop
    End With
    
End Sub
 
Private Function GetRecords(sQuery As String) As ADODB.Recordset
 
    Set GetRecords = New ADODB.Recordset
    
    With GetRecords
        .CursorType = adOpenStatic
        .CursorLocation = adUseClient
        .LockType = adLockPessimistic
        .Source = sQuery
        .ActiveConnection = oConnect        'oConnect is a public ADODB connection
        .Open
    End With
 
    If GetRecords.RecordCount > 0 Then
        GetRecords.MoveFirst
    Else
        GetRecords.Close
        Set GetRecords = Nothing
    End If
 
End Function

[Mark Gambo]

I prefer "Group By" because I seem to have less problems:

sSQL = "SELECT Type FROM Table GROUP BY Type ORDER BY Type;"   'Table is the DB table for the records.
    Set oTemp = GetRecords(sSQL)
    If Not oTemp Is Nothing Then
        FillCombo oTemp, Combo1
    End If
    oTemp.Close

[techspark]

well given your current code, try it like this:

Private Function IsDupe(ByVal cbo As ComboBox, ByVal sItem As String) As Boolean
    IsDupe = (SendMessage(cbo.hWnd, CB_FINDSTRINGEXACT, -1&, ByVal sItem) > -1)
End Function
 
Public Sub FillStatCombos()
    rs.MoveFirst
    Do Until rs.EOF
        If Not IsDupe(Combo1, rs.Fields("Type")) Then Combo1.AddItem rs.Fields("Type")
        If Not IsDupe(Combo2, rs.Fields("Entry")) Then Combo2.AddItem rs.Fields("Entry")
        If Not IsDupe(Combo3, rs.Fields("Entrants")) Then Combo3.AddItem rs.Fields("Entrants")
        rs.MoveNext
    Loop
End Sub

I know this thread is very old, but i have been surfing around the internet stuck in a similar situation and sir, your code worked a charm. !! Thanx a ton.!

[wdallen49]

Can someone provide a mod for bushmobile's code that will solve a similar situation in Excel VBA

[si_the_geek]

Welcome to VBForums

If bushmobile's code doesn't work for you, one of the other suggestions should. The only thing you'll miss is a little bit of speed.

[ravemaster]

I guess select distinct query would be the simplest answer