how to find and remove duplicate entries in Listboxes?

hi all again,

tryin to write a macro likely printmerge etc. now i stopped a point )) actually i can do it in VB6 but here in VBA can not succes over it. my problem is; how can i find and remove duplicate entries in listboxes? (i am gettin datas from excel sheet and listin them to two listboxes cause from excel data they comin sometimes duplicated.) finally i am close to finish and i think gonna be good work ) (apart of corel print merge, it works with images.) regards to all.

[SteveDude]

Bunch of ways in VB6 to do it, many use two listboxes or arrays. Just think of if the listbox as and array an treat it that way in VBA.

yeah, sure i tried them all, for ex: hwnd function doesn't work over it ))) i just asked if someone has better way around it. btw thnx much for your response.

[runflacruiser]

Hi.
I think this is what Steve was referring to:

Something like this.

Sub UniqueList()
Dim i As Long
Dim arr As Variant
Dim Unique As New Collection

arr = Sheet1.Range("input")

For i = 1 To UBound(arr, 1)
    On Error Resume Next
    cUnique.Add arr(i, 1), CStr(arr(i, 1))
Next row

ReDim arr(1 To Unique.Count, 1 To 1)
For i = 1 To Unique.Count
    arr(i, 1) = cUnique(i)
Next row
Sheet1.Range("output").Resize(UBound(arr, 1), 1).Value = arr

End Sub

-John

thnx dear friend. infact first sight, i mean about it, when i got data already (excel, access etc, dunn matter), over form between two listboxes so ur codes givin me clue either... again, thnx much...

[runflacruiser]

Hi.
I needed this same function today.
Hopefully you can adapt or use my code to help.

It is a simple sub that adds shapes text.character.all string to a list box as long as there is not already one with the same name there.

Public Sub createLstBox(Optional nada As Boolean)
    saveSetSTC
    Dim s As Shape, sr As ShapeRange
    Dim c As Long, lItem As Long
    Dim dupBool As Boolean
    
    Set sr = ActiveSelectionRange
    If sr.Count = 0 Then Exit Sub
    
    On Error Resume Next 'for text in shapes!!
    
    c = 1
    For c = 1 To sr.Count
        If sr(c).Text.Story.Characters.Count > 0 Then
            If lst1.ListCount = 0 Then
                lst1.AddItem Trim(sr(c).Text.Story.Characters.All)
            Else
                dupBool = False
                For lItem = 0 To lst1.ListCount - 1
                    If Trim(sr(c).Text.Story.Characters.All) = Trim(CStr(lst1.List(lItem))) Then
                       dupBool = True
                    End If
                Next
                If Not dupBool Then lst1.AddItem Trim(sr(c).Text.Story.Characters.All)
            End If
        End If
    Next c

End Sub

-John

yeah, thnx dear friend. thats it indeed. when project has finished, i'll be appreciate you )) thnx again.