Remove Duplicate Values

[Corey]

I am loading a Combobox with the below cade, but i want to REMOVE any Values from the LIst IF they
are a Duplicate.
How can i add this in to the below code ?

Private Sub ComboBox5_DropButtonClick()
Application.ScreenUpdating = False
If ComboBox5.ListCount > 0 Then Exit Sub
Dim LastCell As Long
Dim myrow As Long
On Error Resume Next
LastCell = Worksheets("Contact List").Cells(Rows.Count, "B").End(xlUp).Row

With ActiveWorkbook.Worksheets("Contact List")
..Select
For myrow = 2 To LastCell

If .Cells(myrow, 2) <> "" Then
If Cells(myrow, 2).Value <> "" Then
ComboBox5.AddItem Cells(myrow, 2)
End If
End If
Next
End With
End Sub



Corey....

 

[Tom Ogilvy]

Private Sub ComboBox5_DropButtonClick()
Application.ScreenUpdating = False
Dim nodupes as Collection
If ComboBox5.ListCount > 0 Then Exit Sub
Dim LastCell As Long
Dim myrow As Long
On Error Resume Next
LastCell = Worksheets("Contact List").Cells(Rows.Count, "B").End(xlUp).Row

With ActiveWorkbook.Worksheets("Contact List")
..Select
set nodupes = New Collection
For myrow = 2 To LastCell

If .Cells(myrow, 2).Value <> "" Then
On error resume Next
nodupes cells(myrow,2).Value, cStr(cells(myrow,2).Value)
if err.Number = 0 then
ComboBox5.AddItem Cells(myrow, 2)
end if
On Error goto 0
End If
Next
End With
End Sub

 

[Corey]

Tom i get an error at this line:
nodupes cells(myrow,2).Value, cStr(cells(myrow,2).Value)


A 'Wrong No of arguements' Comile error??
Private Sub ComboBox5_DropButtonClick()
Application.ScreenUpdating = False
Dim nodupes as Collection
If ComboBox5.ListCount > 0 Then Exit Sub
Dim LastCell As Long
Dim myrow As Long
On Error Resume Next
LastCell = Worksheets("Contact List").Cells(Rows.Count, "B").End(xlUp).Row

With ActiveWorkbook.Worksheets("Contact List")
..Select
set nodupes = New Collection
For myrow = 2 To LastCell

If .Cells(myrow, 2).Value <> "" Then
On error resume Next
nodupes cells(myrow,2).Value, cStr(cells(myrow,2).Value)
if err.Number = 0 then
ComboBox5.AddItem Cells(myrow, 2)
end if
On Error goto 0
End If
Next
End With
End Sub

 

[merjet]

Replace the lines after your On Error stmt with:

Set ws = Worksheets("Contact List")
LastCell = ws.Cells(Rows.Count, "B").End(xlUp).Row
Set rng = ws.Range("B2:B" & LastCell)
rng.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set rng = rng.SpecialCells(xlCellTypeVisible)
With rng
For Each c In rng
ComboBox5.AddItem c
Next
End With
ws.ShowAllData

Hth,
Merjet

 

[Corey]

Merjet,
Do you mean:

Private Sub ComboBox5_DropButtonClick()
Application.ScreenUpdating = False
If ComboBox5.ListCount > 0 Then Exit Sub
Dim LastCell As Long
Dim myrow As Long
On Error Resume Next
Set ws = Worksheets("Contact List")
LastCell = ws.Cells(Rows.Count, "B").End(xlUp).Row
Set rng = ws.Range("B2:B" & LastCell)
rng.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set rng = rng.SpecialCells(xlCellTypeVisible)
With rng
For Each c In rng
ComboBox5.AddItem c
Next
End With
ws.ShowAllData
Application.ScreenUpdating = True
End Sub

Like the baove.
I get NO error's but i still get DUPLICATE Values??

Corey....
Replace the lines after your On Error stmt with:

Set ws = Worksheets("Contact List")
LastCell = ws.Cells(Rows.Count, "B").End(xlUp).Row
Set rng = ws.Range("B2:B" & LastCell)
rng.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set rng = rng.SpecialCells(xlCellTypeVisible)
With rng
For Each c In rng
ComboBox5.AddItem c
Next
End With
ws.ShowAllData

Hth,
Merjet

 

[kounoike]

Are you sure there is no item in ComboBox5 when you run this code first
time?
if not, i think you need to remove all items before this.

keizi

 

[Tom Ogilvy]

My typo:

nodupes.Add cells(myrow,2).Value, cStr(cells(myrow,2).Value)

 

[merjet]

Corey,
You had your code in the ComboBox5_DropButtonClick event. It should
probably be elsewhere, e.g. Userform_Initialize, or as kounoike
suggested, clear ComboBox5 before populating it (in case the user
clicks the DropButton more than once).

Hth,
Merjet