Remove Duplicate Values
 

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....

Remove Duplicate Values
 

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

--
Regards,
Tom Ogilvy



"Corey" wrote in message
...
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....

Remove Duplicate Values
 

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??
"Tom Ogilvy" wrote in message ...
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

--
Regards,
Tom Ogilvy



"Corey" wrote in message
...
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....

Remove Duplicate Values
 

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

Remove Duplicate Values
 

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....
"merjet" wrote in message
oups.com...
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

Remove Duplicate Values
 

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

"Corey" wrote in message
...
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....
"merjet" wrote in message
oups.com...
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

Remove Duplicate Values
 

My typo:

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


--
Regards,
Tom Ogilvy

"Corey" wrote in message
...
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??
"Tom Ogilvy" wrote in message
...
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

--
Regards,
Tom Ogilvy



"Corey" wrote in message
...
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....

Remove Duplicate Values
 

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