Still stuck removing duplicate values

[Corey]

The below code populates a listbox for me, but i want ONLY unique values listed, currently i am
getting a few duplicate values populating in the listbox.
How can i remove them to ONLY display 1 value of the duplicate values ?

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

With ActiveWorkbook.Worksheets("Contact List")
..Select 'first thing to do with a With statement that occurs on a second sheet
For myrow = 1 To LastCell
If .Cells(myrow, 1) <> "" Then
If .Cells(myrow, 1).Offset(0, 1).Value = ListBox1.Value Then
ComboBox1.AddItem Cells(myrow, 1)
End If
End If
Next
End With
Application.ScreenUpdating = True

End Sub


Corey....

 

[Tom Ogilvy]

Try using the code that was already provided which used a collection to
insure only unique entries were included. .

 

[Corey]

Tom,
I kept getting an error in one line and could not work out how to fix it.

nodupes Cells(myrow, 2).Value, CStr(Cells(myrow, 2).Value) "==== Wrong Number of Arguements ????



Try using the code that was already provided which used a collection to
insure only unique entries were included. .

 

[Tom Ogilvy]

Here it is. Use the same approach.

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

so the adaptation would be:

Private Sub ListBox1_Change()
Application.ScreenUpdating = False
If ComboBox1.ListCount > 0 Then ComboBox1.Clear
Dim LastCell As Long
Dim myrow As Long
Dim nodupes as Collect
On Error Resume Next
LastCell = Worksheets("Contact List").Cells(Rows.Count, "A").End(xlUp).Row

With ActiveWorkbook.Worksheets("Contact List")
.Select 'first thing to do with a With statement that occurs on a second
set nodupes = new collection
For myrow = 1 To LastCell
If .Cells(myrow, 1) <> "" Then
If .Cells(myrow, 1).Offset(0, 1).Value = ListBox1.Value Then
on error resume next
nodupes.add .cells(myrow,1).Value, _
cstr(.cells(myrow,1).Value)
if err.Number = 0 then
ComboBox1.AddItem .Cells(myrow, 1)
end if
on Error goto 0
End If
End If
Next
End With
Application.ScreenUpdating = True

End Sub

 

[Corey]

Thanks Tom, you steered me on the right path.
Ended up using this :

Application.ScreenUpdating = False
Dim LastCell As Long
Dim myrow As Long
Dim nodupes As Collection
On Error Resume Next
LastCell = Worksheets("Contact List").Cells(Rows.Count, "B").End(xlUp).Row

With ActiveWorkbook.Worksheets("Contact List")
.Select 'first thing to do with a With statement that occurs on a second
Set nodupes = New Collection
For myrow = 1 To LastCell
If .Cells(myrow, 2) <> "" Then
' If .Cells(myrow, 2).Value = ListBox1.Value Then
On Error Resume Next
nodupes.Add .Cells(myrow, 2).Value, CStr(.Cells(myrow, 2).Value)
If Err.Number = 0 Then
ListBox1.AddItem .Cells(myrow, 2)
End If
On Error GoTo 0
End If
' End If
Next
End With
Application.ScreenUpdating = True

Thanks

Corey....

Here it is. Use the same approach.

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

so the adaptation would be:

Private Sub ListBox1_Change()
Application.ScreenUpdating = False
If ComboBox1.ListCount > 0 Then ComboBox1.Clear
Dim LastCell As Long
Dim myrow As Long
Dim nodupes as Collect
On Error Resume Next
LastCell = Worksheets("Contact List").Cells(Rows.Count, "A").End(xlUp).Row

With ActiveWorkbook.Worksheets("Contact List")
.Select 'first thing to do with a With statement that occurs on a second
set nodupes = new collection
For myrow = 1 To LastCell
If .Cells(myrow, 1) <> "" Then
If .Cells(myrow, 1).Offset(0, 1).Value = ListBox1.Value Then
on error resume next
nodupes.add .cells(myrow,1).Value, _
cstr(.cells(myrow,1).Value)
if err.Number = 0 then
ComboBox1.AddItem .Cells(myrow, 1)
end if
on Error goto 0
End If
End If
Next
End With
Application.ScreenUpdating = True

End Sub

 

[Tom Ogilvy]

I posted a correction to that line in the original thread in response to
your post that you were getting an error. It was a typo on my part.

 

[Corey]

Must have missed that.
For some reason i seem to get not ALL new posts coming through.
I posted a correction to that line in the original thread in response to
your post that you were getting an error. It was a typo on my part.