Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default remove duplicates in listbox

:(
Sorry if this is a stupid problem but I am very new to VBA. I a
writing a VBA app in a CAD program and I have managed to get
multi-column listbox which is exactly what I want, except for th
duplicate entrys (see attached image).
Is there any way to now get rid of the duplicates (entire row) from th
listbox?

Thanks for any help anyone can provide, as I'm really lost.... ;-)

Bria

Attachment filename: listbox.jpg
Download attachment: http://www.excelforum.com/attachment.php?postid=55050
--
Message posted from http://www.ExcelForum.com

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 9
Default remove duplicates in listbox

He
subSetupform()
For Each c In frmAddEntry.Controls
If Left(c.Name, 2) = "cb" Then
c.List = CreateList(YourRangeAddress)
End If
Next c
End Sub


Function CreateList(myRange)
Dim myControl
Dim mystring As String
Dim Cell As Range
Dim NoDupes As New Collection
Dim i As Integer
Dim j As Integer
Dim Swap1, Swap2, Item
Dim cbList() As Variant

' The next statement ignores the error caused by attempting to add
' a duplicate key to the collection.
' The duplicate is not added - which is just what we want!
On Error Resume Next
For Each Cell In Range(myRange)
If Cell.Value < "" Then NoDupes.Add Cell.Value, Cell.Value
' Note: the 2nd argument (key) for the Add method must be a
string
Next Cell

On Error GoTo 0

' Sort the collection (optional)
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, befo=j
NoDupes.Add Swap2, befo=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i

' Add the sorted, non-duplicated items to a ComboBox
ReDim cbList(NoDupes.Count) 'reset to same number as in no dupes
j = 0
For Each Item In NoDupes
j = j + 1
If Item < "" Then cbList(j) = Item
Next Item

For j = 1 To NoDupes.Count ' Remove names from the collection.
NoDupes.Remove 1 ' removes the current first member on each
iteration.
Next

CreateList = cbList()
End Function

Now go buy a Power Programming book by :John Walkenbach
BEST investment you'll ever make!

Carl


"bcorbin " wrote in message
...
:(
Sorry if this is a stupid problem but I am very new to VBA. I am
writing a VBA app in a CAD program and I have managed to get a
multi-column listbox which is exactly what I want, except for the
duplicate entrys (see attached image).
Is there any way to now get rid of the duplicates (entire row) from the
listbox?

Thanks for any help anyone can provide, as I'm really lost.... ;-)

Brian

Attachment filename: listbox.jpg
Download attachment:

http://www.excelforum.com/attachment.php?postid=550502
---
Message posted from http://www.ExcelForum.com/



  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 27,285
Default remove duplicates in listbox

You can also see the original version of the code at John Walkenbach's site:

http://j-walk.com/ss/excel/tips/tip47.htm
Filling a ListBox With Unique Items

although Carl has altered it slightly to make it a function.

--
Regards,
Tom Ogilvy


"cmdecker2" wrote in message
news:0UYqc.38227$5a.6371@okepread03...
He
subSetupform()
For Each c In frmAddEntry.Controls
If Left(c.Name, 2) = "cb" Then
c.List = CreateList(YourRangeAddress)
End If
Next c
End Sub


Function CreateList(myRange)
Dim myControl
Dim mystring As String
Dim Cell As Range
Dim NoDupes As New Collection
Dim i As Integer
Dim j As Integer
Dim Swap1, Swap2, Item
Dim cbList() As Variant

' The next statement ignores the error caused by attempting to add
' a duplicate key to the collection.
' The duplicate is not added - which is just what we want!
On Error Resume Next
For Each Cell In Range(myRange)
If Cell.Value < "" Then NoDupes.Add Cell.Value, Cell.Value
' Note: the 2nd argument (key) for the Add method must be a
string
Next Cell

On Error GoTo 0

' Sort the collection (optional)
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, befo=j
NoDupes.Add Swap2, befo=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i

' Add the sorted, non-duplicated items to a ComboBox
ReDim cbList(NoDupes.Count) 'reset to same number as in no dupes
j = 0
For Each Item In NoDupes
j = j + 1
If Item < "" Then cbList(j) = Item
Next Item

For j = 1 To NoDupes.Count ' Remove names from the collection.
NoDupes.Remove 1 ' removes the current first member on each
iteration.
Next

CreateList = cbList()
End Function

Now go buy a Power Programming book by :John Walkenbach
BEST investment you'll ever make!

Carl


"bcorbin " wrote in message
...
:(
Sorry if this is a stupid problem but I am very new to VBA. I am
writing a VBA app in a CAD program and I have managed to get a
multi-column listbox which is exactly what I want, except for the
duplicate entrys (see attached image).
Is there any way to now get rid of the duplicates (entire row) from the
listbox?

Thanks for any help anyone can provide, as I'm really lost.... ;-)

Brian

Attachment filename: listbox.jpg
Download attachment:

http://www.excelforum.com/attachment.php?postid=550502
---
Message posted from http://www.ExcelForum.com/





Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
remove all duplicates? snow Excel Discussion (Misc queries) 3 June 2nd 10 09:54 AM
remove duplicates BlindShelter Excel Discussion (Misc queries) 2 December 19th 08 08:45 PM
Remove data with listbox Josh[_9_] Excel Programming 8 February 24th 04 05:22 PM
Simple Listbox question - how to remove items TBA[_2_] Excel Programming 3 January 10th 04 02:18 AM
Getting Duplicates in ListBox Tony Bender Excel Programming 2 September 26th 03 05:31 PM


All times are GMT +1. The time now is 09:07 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"