Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

URGENT - How to remove duplicate items from an array??

Status
Not open for further replies.

ftpdoo

Programmer
Aug 9, 2001
202
GB

I have a array in VBA called MyArray(50) and it contains the names of towns and some of these names have been entered into the array more than once.

Can someone please help me with the algorithm to remove any duplicate items..

I'm taking these values from a database so if its easier any duplicates could be removed while populating the array..

Many thankx in advance,
Jonathan
 
you need three arrays

your original myarray
Your new myarraynew
You new comparioson mycomp

the original is the array at the moment
you new array is the array with no duplicates at the moment empty

your new comparison array is an array used to check to see fi the value is in the new array.

now use integers and ubound to move through these in a loop and you going to need a boolean value as well, plus you are going to have to redim the mycomp array each time and you need a string comparison so your loop might look something like this, ive written that blind but look up redim statements in help or on google.



do until x = ubound(myarray)
strcom = myarraty(x,1)
do until y = ubound(mycomp)
if strcom = mycomp(y,1) then
boladd = false
else
boladd = true
end if
y = y + 1
loop

if boladd = true then
mynew(z,1) = strcom
z = z + 1
re dim mycomp() = mynew()
end if

x = x + 1
loop

 
Code:
Public Function basRmvArryDup(MyArray As Variant) As Variant

    'Function to remove duplicate entries in a (Single Dimension) Array

    Dim Idx As Long
    Dim Jdx As Long
    Dim Dupe As Long
    Dim Sorted As Boolean
    Dim tmp As Variant
    Dim NewArray() As Variant

    'Just make a copy (to be safe)
    ReDim NewArray(UBound(MyArray))
    For Idx = 0 To UBound(MyArray)
        If (MyArray(Idx) <> &quot;&quot;) Then
            NewArray(Idx) = MyArray(Idx)
        End If
    Next Idx
    ReDim Preserve NewArray(Idx - 1)
    
    'Sort the incomming
    Do While Not Sorted
        Sorted = True       'Assume it arrives properly sorted
        For Idx = 0 To UBound(NewArray) - 1
            If (NewArray(Idx) > NewArray(Idx + 1)) Then
                tmp = NewArray(Idx)
                NewArray(Idx) = NewArray(Idx + 1)
                NewArray(Idx + 1) = tmp
                Sorted = False
            End If
        Next Idx
    Loop

    'Remove the duplicates
    Dupe = UBound(NewArray)
    For Idx = 0 To UBound(NewArray) - 1
        If (NewArray(Idx) = NewArray(Idx + 1)) Then
            'Found the Duplicate.  Remove It
            For Jdx = Idx + 1 To UBound(NewArray) - 1
                NewArray(Jdx) = NewArray(Jdx + 1)
            Next Jdx
            Dupe = Dupe - 1
        End If
    Next Idx

    ReDim Preserve NewArray(Dupe + 1)

    basRmvArryDup = NewArray

End Function
Public Function basTestRmvDupAray()

    Dim TheArray(50) As Variant
    Dim NoDupArray() As Variant

    TheArray(0) = &quot;Annapolis&quot;
    TheArray(1) = &quot;Baltimore&quot;
    TheArray(2) = &quot;Columbia&quot;
    TheArray(3) = &quot;Rockville&quot;
    TheArray(4) = &quot;Gaithersburg&quot;
    TheArray(5) = &quot;Silver Spring&quot;
    TheArray(6) = &quot;Wheaton&quot;
    TheArray(7) = &quot;Laurel&quot;
    TheArray(8) = &quot;Timinioum&quot;
    TheArray(9) = &quot;White Marsh&quot;
    TheArray(10) = &quot;Edgewater&quot;
    TheArray(11) = &quot;South River&quot;
    TheArray(12) = &quot;Severn&quot;
    TheArray(13) = &quot;Washington&quot;
    TheArray(14) = &quot;Fort Washington&quot;
    TheArray(15) = &quot;Dundalk&quot;
    TheArray(16) = &quot;Shady Side&quot;
    TheArray(17) = &quot;Calvert Cliffs&quot;
    TheArray(18) = &quot;Aberdeen&quot;
    TheArray(19) = &quot;Dover&quot;
    TheArray(20) = &quot;Trentom&quot;
    TheArray(21) = &quot;White Plains&quot;
    TheArray(22) = &quot;San Diego&quot;
    TheArray(23) = &quot;San Francisco&quot;
    TheArray(24) = &quot;Seattle&quot;
    TheArray(25) = &quot;Chicago&quot;
    TheArray(26) = &quot;Green Bay&quot;
    TheArray(27) = &quot;Tampa Bay&quot;
    TheArray(28) = &quot;Orlando&quot;
    TheArray(29) = &quot;Pierson&quot;
    TheArray(30) = &quot;Jacksonville&quot;
    TheArray(31) = &quot;Miami&quot;
    TheArray(32) = &quot;Orlando&quot;
    TheArray(33) = &quot;Tampa&quot;
    TheArray(34) = &quot;Tempe&quot;
    TheArray(35) = &quot;Denver&quot;
    TheArray(36) = &quot;Ft. Lauderdale&quot;
    TheArray(37) = &quot;Islamorada&quot;
    TheArray(38) = &quot;Marathon&quot;
    TheArray(39) = &quot;Athens&quot;
    TheArray(40) = &quot;Cario&quot;
    TheArray(41) = &quot;London&quot;
    TheArray(42) = &quot;Lima&quot;
    TheArray(43) = &quot;Hong Kong&quot;
    TheArray(44) = &quot;Seoul&quot;
    TheArray(45) = &quot;Tokyo&quot;
    TheArray(46) = &quot;Islamabad&quot;
    TheArray(47) = &quot;Perth&quot;
    TheArray(48) = &quot;Sidney&quot;
    TheArray(49) = &quot;Agana&quot;
    TheArray(50) = &quot;White Plains&quot;

    NoDupArray = basRmvArryDup(TheArray)
    Debug.Print UBound(NoDupArray)
    Debug.Print

End Function
MichaelRed
mred@att.net

There is never time to do it right but there is always time to do it over
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top