• Status: Solved
• Priority: Medium
• Security: Public
• Views: 277

# Removing duplicate data from an array

The code below displays job numbers.

CompleteJobs.JobNum2(K).Text = TempJobs2(M)
K = K + 1
M = M + 1
Loop Until TempJobs2(M) = Empty

The problem is duplicate numbers are displayed. How can i remove the duplicate job numbers when displaying.
0
mari_carmen
1 Solution

Commented:
From the EE FAQ:

"It is up to you to assign points to the question based on its difficulty. As a guide, a basic question is worth 50 points, an intermediate question 100 points, and an advanced question 200 points. The more points assigned to a question, the more likely it will be answered."

0

Commented:
Mirkwood is right, yous should need to give more points

' #VBIDEUtils#************************************************************
' * Programmer Name  : Waty Thierry
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : waty.thierry@usa.net
' * Date             : 25/09/98
' * Time             : 13:20
' * Module Name      : Array_Module
' * Module Filename  : Array.bas
' **********************************************************************
' * Comments         : Some routines for Array and collections.
' *
' *
' **********************************************************************

Option Explicit

Private Const ordSortVal = 0
Private Const ordSortText = 1
Private Const ordSortBin = 2
Private Const ordSortLen = 3

Private ordMode         As Integer
Private fSortHiToLo     As Integer

Public Function RemoveDupes(vData As Variant)
' ---------------------------------------------------------
' Syntax:     RemoveDupes TmpAray()
' Parameters:
'     vData - A variant pointing to an array to be parsed
'             for duplicate values assuming the data has
'             already been sorted by some other means
' ---------------------------------------------------------
' Test to see if an array was passed
' ---------------------------------------------------------

If Not IsArray(vData) Then Exit Function
' ---------------------------------------------------------
' Define variables
' ---------------------------------------------------------
Dim lCurIndex As Long
Dim lNextIndex As Long
Dim lNewIndex As Long
Dim i As Long
Dim Hi As Long
Dim vtemp As Variant
' ---------------------------------------------------------
' Initialize variables
' ---------------------------------------------------------
Hi = UBound(vData)   ' upper end of the array

lNewIndex = 1
i = 1
ReDim tmpAray(1 To Hi) As String
' ---------------------------------------------------------
' Move the first valid value to the new array
' ---------------------------------------------------------
Do
If Len(vData(i)) <> 0 Then
tmpAray(lNewIndex) = vData(i)
Exit Do
End If

i = i + 1   ' Increment the counter

Loop
' ---------------------------------------------------------

' Increment the counter so that we start comparing with
' the next value in the FOR NEXT loop
' ---------------------------------------------------------
i = i + 1
' ---------------------------------------------------------
' Start the comparison process.  We will go thru every
' item in the array and look for duplicate values.
' ---------------------------------------------------------
For lCurIndex = i To Hi

' increment the counter for the next

' item in the array and empty the
' temporary holding variable
lNextIndex = lCurIndex + 1
vtemp = ""
' if we have reached the end of the
' array then leave before we get a
' "Subscript out of range" error.
If lNextIndex > Hi Then Exit For
' See if we already have it in the new
' array.  If yes, then empty the array item
If vData(lCurIndex) = tmpAray(lNewIndex) Then
vData(lCurIndex) = ""

End If
' if the value is greater than an empty string,
' move the data to a temporary holding variable
If Len(Trim(vData(lCurIndex))) > 0 Then
vtemp = vData(lCurIndex)
' See if the data is in the array starting
' from the next position and go to the end.
' If it is not in the array then add it
' to the new array and increment the count.
' We will pass the complete array, the data

' to look for, and the stating point in the
' array.
If IsInArray(vData, vtemp, lNextIndex) Then
vData(lCurIndex) = ""
Else
' increment the index for the new array
' and add the item of data to it.
lNewIndex = lNewIndex + 1
tmpAray(lNewIndex) = vtemp
End If
End If
'
Next
' ---------------------------------------------------------

' Empty the passed array
' ---------------------------------------------------------
ReDim vData(1 To Hi) As String
' ---------------------------------------------------------
' if you are using an external sort routine, then
' resort the data to move all the null strings to the
' end of the array.
' ---------------------------------------------------------
' sort_routine tmpAray()
' ---------------------------------------------------------
' Transfer data from the temp(New) array back into

' the passed array
' ---------------------------------------------------------
For lCurIndex = 1 To Hi
vData(lCurIndex) = tmpAray(lCurIndex)
Next
End Function

Private Function IsInArray(vData As Variant, vSrchData As Variant, lStart As Long) As Boolean
' ---------------------------------------------------------
' Syntax:     IsInArray tmpArray(), sSrchData, lStart
'
' Parameters:
'     vData - A variant pointing to an array to be
'             parsed for duplicate values

'
'  vSrcData - A value in the array to look for
'
'    lStart - The starting point in the array
'
' We want to determine if an item is already
' in this array.  We do this by looping through and
' comparing the sSrchData with each item in the array.
' Since we started with the next item in the array, we
' should not have a duplicate.
' ---------------------------------------------------------
' Test to see if an array was passed
' ---------------------------------------------------------

If Not IsArray(vData) Then Exit Function
' ---------------------------------------------------------
' Define local variable
' ---------------------------------------------------------
Dim Hi As Long
' ---------------------------------------------------------
' upper end of the array
' ---------------------------------------------------------
Hi = UBound(vData)
' ---------------------------------------------------------
' start of at the designated array element

' ---------------------------------------------------------
Do Until lStart > Hi
' Look for a match in the array
' If vData(lStart) = vSrchData Then
If StrComp(vData(lStart), vSrchData, 0) = 0 Then
'
' We found a match in the array
IsInArray = True
Exit Function
'
End If
' increment the array index counter
lStart = lStart + 1
Loop
' ---------------------------------------------------------

' The search item could not be found in the array
' ---------------------------------------------------------
IsInArray = False
End Function

Sub SortArray(aTarget() As Variant, iFirst As Integer, iLast As Integer)
' #VBIDEUtils#************************************************************
' * Programmer Name  : Waty Thierry
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : waty.thierry@usa.net
' * Date             : 30/10/98
' * Time             : 14:18
' * Module Name      : Array_Module
' * Module Filename  : D:\TWA\Lib\Array.bas
' * Procedure Name   : SortArray
' * Parameters       :
' *                    aTarget() As Variant
' *                    iFirst As Integer
' *                    iLast As Integer
' **********************************************************************
' * Comments         : Sort an array using QuickSort algorithm
' *
' *
' **********************************************************************

Dim vSplit As Variant

If iFirst < iLast Then

' Only two elements in this subdivision; exchange if
' they are out of order, and end recursive calls
If iLast - iFirst = 1 Then
If SortCompare(aTarget(iFirst), aTarget(iLast)) > 0 Then
SortSwap aTarget(iFirst), aTarget(iLast)
End If
Else

Dim i As Integer, J As Integer, iRand As Integer

' Pick pivot element at random and move to end
' (consider calling Randomize before sorting)
iRand = GetRandom(iFirst, iLast)
SortSwap aTarget(iLast), aTarget(iRand)
vSplit = aTarget(iLast)
Do

' Move in from both sides toward pivot element
i = iFirst: J = iLast
Do While (i < J) And _
SortCompare(aTarget(i), vSplit) <= 0
i = i + 1
Loop
Do While (J > i) And _
SortCompare(aTarget(J), vSplit) >= 0
J = J - 1
Loop

' If you haven't reached pivot element, it means
' that the two elements on either side are out of
' order, so swap them
If i < J Then
SortSwap aTarget(i), aTarget(J)
End If
Loop While i < J

' Move pivot element back to its proper place
SortSwap aTarget(i), aTarget(iLast)

' Recursively call SortArray (pass smaller
' subdivision first to use less stack space)
If (i - iFirst) < (iLast - i) Then
SortArray aTarget(), iFirst, i - 1
SortArray aTarget(), i + 1, iLast
Else
SortArray aTarget(), i + 1, iLast
SortArray aTarget(), iFirst, i - 1
End If
End If
End If

End Sub

Sub SortCollection(nTarget As Collection, iFirst As Integer, iLast As Integer)
' #VBIDEUtils#************************************************************
' * Programmer Name  : Waty Thierry
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : waty.thierry@usa.net
' * Date             : 30/10/98
' * Time             : 14:19
' * Module Name      : Array_Module
' * Module Filename  : D:\TWA\Lib\Array.bas
' * Procedure Name   : SortCollection
' * Parameters       :
' *                    nTarget As Collection
' *                    iFirst As Integer
' *                    iLast As Integer
' **********************************************************************
' * Comments         : Sort a collection using QuickSort algorithm
' *
' *
' **********************************************************************

Dim vSplit        As Variant
Static fRand      As Integer

If fRand = False Then
Randomize
fRand = True
End If

If iFirst < iLast Then

' Only two elements in this subdivision; exchange if
' they are out of order, and end recursive calls
If iLast - iFirst = 1 Then
If SortCompare(nTarget(iFirst), nTarget(iLast)) > 0 Then
CollectionSwap nTarget, iFirst, iLast
End If
Else

Dim i As Integer, J As Integer, iRand As Integer

' Pick pivot element at random and move to end
' (consider calling Randomize before sorting)
iRand = GetRandom(iFirst, iLast)
CollectionSwap nTarget, iLast, iRand
vSplit = nTarget(iLast)
Do

' Move in from both sides toward pivot element
i = iFirst: J = iLast
Do While (i < J) And _
SortCompare(nTarget(i), vSplit) <= 0
i = i + 1
Loop
Do While (J > i) And _
SortCompare(nTarget(J), vSplit) >= 0
J = J - 1
Loop

' If you haven't reached pivot element, it means
' that the two elements on either side are out of
' order, so swap them
If i < J Then
CollectionSwap nTarget, i, J
End If
Loop While i < J

' Move pivot element back to its proper place
CollectionSwap nTarget, i, iLast

' Recursively call SortCollection (pass smaller
' subdivision first to use less stack space)
If (i - iFirst) < (iLast - i) Then
SortCollection nTarget, iFirst, i - 1
SortCollection nTarget, i + 1, iLast
Else
SortCollection nTarget, i + 1, iLast
SortCollection nTarget, iFirst, i - 1
End If
End If
End If

End Sub

Function BSearchArray(av() As Variant, vKey As Variant, iPos As Integer) As Boolean

Dim iLo           As Integer
Dim iHi           As Integer
Dim iComp         As Integer
Dim iMid          As Integer

iLo = LBound(av): iHi = UBound(av)
Do
iMid = iLo + ((iHi - iLo) \ 2)
iComp = SortCompare(av(iMid), vKey)
Select Case iComp
Case 0
' Item found
iPos = iMid
BSearchArray = True
Exit Function
Case Is > 0
' Item is in upper half
iHi = iMid
If iLo = iHi Then Exit Do
Case Is < 0
' Item is in lower half
iLo = iMid + 1
If iLo > iHi Then Exit Do
End Select
Loop

iPos = iMid - (iComp < 0)
BSearchArray = False

End Function

Function BSearchCollection(n As Collection, vKey As Variant, iPos As Integer) As Boolean
' #VBIDEUtils#************************************************************
' * Programmer Name  : Waty Thierry
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : waty.thierry@usa.net
' * Date             : 25/09/98
' * Time             : 13:20
' * Module Name      : Array_Module
' * Module Filename  : Array.bas
' * Procedure Name   : BSearchCollection
' * Parameters       :
' *                    n As Collection
' *                    vKey As Variant
' *                    iPos As Integer
' **********************************************************************
' * Comments         : Search for a key in a collection
' *
' *
' **********************************************************************

Dim iLo           As Integer
Dim iHi           As Integer
Dim iComp         As Integer
Dim iMid          As Integer

iLo = 1: iHi = n.count
Do
iMid = iLo + ((iHi - iLo) \ 2)
iComp = SortCompare(n(iMid), vKey)
Select Case iComp
Case 0
' Item found
iPos = iMid
BSearchCollection = True
Exit Function
Case Is > 0
' Item is in upper half
iHi = iMid
If iLo = iHi Then Exit Do
Case Is < 0
' Item is in lower half
iLo = iMid + 1
If iLo > iHi Then Exit Do
End Select
Loop
iPos = iMid - (iComp < 0)
BSearchCollection = False

End Function

Sub ShuffleArray(A() As Variant)

Dim iFirst As Integer, iLast As Integer
iFirst = LBound(A): iLast = UBound(A)

' Randomize array
Dim i As Integer, v As Variant, iRnd As Integer
For i = iLast To iFirst + 1 Step -1
' Swap random element with last element
iRnd = GetRandom(iFirst, i)
SortSwap A(i), A(iRnd)
Next

End Sub

Sub ShuffleCollection(n As Collection)

Dim iFirst As Integer, iLast As Integer
iFirst = 1: iLast = n.count

' Randomize collection
Dim i As Integer, v As Variant, iRnd As Integer
For i = iLast To iFirst + 1 Step -1
' Swap random element with last element
iRnd = GetRandom(iFirst, i)
CollectionSwap n, i, iRnd
Next

End Sub

Sub SortSwap(v1 As Variant, v2 As Variant)

Dim vt As Variant

vt = v1
v1 = v2
v2 = vt

End Sub

Sub CollectionSwap(n As Collection, i1 As Integer, i2 As Integer)

Dim vt As Variant

vt = n(i1)
n.Remove i1
n.Remove i2

End Sub

Public Function SortCompare(v1 As Variant, v2 As Variant) As Integer

' Use string comparisons only on strings
If TypeName(v1) <> "String" Then ordMode = ordSortVal

Dim i As Integer
Select Case ordMode
' Sort by value (same as ordSortBin for strings)
Case ordSortVal
If v1 < v2 Then
i = -1
ElseIf v1 = v2 Then
i = 0
Else
i = 1
End If
' Sort case-insensitive
Case ordSortText
i = StrComp(v1, v2, 1)
' Sort case-sensitive
Case ordSortBin
i = StrComp(v1, v2, 0)
' Sort by string length
Case ordSortLen
If Len(v1) = Len(v2) Then
If v1 = v2 Then
i = 0
ElseIf v1 < v2 Then
i = -1
Else
i = 1
End If
ElseIf Len(v1) < Len(v2) Then
i = -1
Else
i = 1
End If
End Select

If fSortHiToLo Then i = -i
SortCompare = i

End Function

Function GetRandom(iLo As Integer, iHi As Integer) As Integer

GetRandom = Int(iLo + (Rnd * (iHi - iLo + 1)))

End Function

0

Commented:
c'mon boys.... mari_carmen is only with us since 13 June. I've heard that some new people did not get the customary 200 points to start with. If mari_carmen is one of those unfortunates, it would add up to (16 days) 80 points or thereabouts. No wonder mari_carmen has only got 25 points to spare...

mari_carmen, did you get your 200 points when you started (don't lie because Mirkwood has ways and means of checking... :o)

0

Commented:
What I'd do with an array to remove dupes is this:

Dim aCol as New Collection

On Error Resume Next

Dim i As Long
For i = LBound(TempJobs2) to UBound(TempJobs2)
Next i

For i = 1 To aCol.Count
CompleteJobs.JobNum2(i).Text = aCol(i)
Next i

Set aCol = Nothing

It seems a bit simpler than waty's solution to me. Admittedly, it does use more memory than waty's suggestion, but it seems to me that the simplest way is often the best.

And I can't remember if Collections are 1 based or 0 based. If they are 0 based, then the For line should read:
For i = 0 to aCol.Count - 1

And that's it.

J.
0

Commented:
Collections are 1-based.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.