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

# create an unique array

Hi,

arr1() is an array consists of 9 different items as follows:

arr1(1) = “Red” , arr1(2) = “Blue”, arr1(3) = “Blue”, arr1(4) = “Yellow”, arr1(5) = “Red”, arr1(6) = “Red”, arr1(7) = “Blue”, arr1(8) = “Green”, arr1(9) = “Red”

I need the code which can create arr2() which should be an UNIQUE array, I mean it should be as follows:  arr2(1) = “Red” , arr2(2) = “Blue”, arr2(3) = “Yellow”, arr2(4) = “Green”

Notes: arr1() items are not fixed (every time contains different Data)  THEN  the long of arr2() is not fixed (it depends on arr1() data)

ray14
0
ray14
• 5
• 3
• 2
• +2
1 Solution

Commented:
Sounds like homework.

Try something along these lines

dimension arr2()  ' allows it to be redimensioned

for each element of arr1
set found = false
loop through the elements of arr2
if arr1(x) = arr2(y)
set found = true
redeimension arr2 to current size +1
set max element of arr2 to arr1(x)

arr2 now has the unique values in arr1

mlmcc
0

Commented:
Option Explicit

Text1.Text = "Red Blue Blue Yellow Red Red Blue Green Red"
End Sub

Private Sub Text1_Change()
Dim arr1() As String, arr2() As String, i As Long

arr1 = Split(Text1.Text, " ")
arr2 = RemoveDupes(Split(Text1.Text, " "))
Caption = ""
For i = 0 To UBound(arr2) - 1
Caption = Caption & arr2(i) & " "
Next
End Sub

Public Function RemoveDupes(arr As Variant) As Variant
Dim col As Collection, v As Variant, i As Long, arrResult() As String
On Error Resume Next
Set col = New Collection

' uses the fact that collection doesn't accept items with the same key
For i = 0 To UBound(arr) - 1
If Err Then ' item already exists
Err.Clear
End If
Next

' copy from collection to array
ReDim arrResult(0 To col.Count - 1)
For i = 1 To col.Count
arrResult(i - 1) = col.Item(i)
Next

RemoveDupes = arrResult ' return array
End Function
0

Commented:
First thing choose a char that is sure not included inside any array element
(may be Tab)

For I = 1 To UBound(arr1)
If InStr(sArr, arr1(I)) = 0 Then
sArr = sArr & arr1(I) & vbTab
End If
Next
arr2 = Split(sArr, vbTab)

for I = 1 to UBound (arr1)

sArr =sArr & arr1(I)
next
0

Commented:
too slow
:-)
0

Commented:
OOPS, small looping error "0 To UBound(arr) - 1"    :-)

Option Explicit

Text1.Text = "Red Blue Blue Yellow Red Red Blue Green Red"
End Sub

Private Sub Text1_Change()
Dim arr1() As String, arr2() As String, i As Long

arr1 = Split(Text1.Text, " ")
arr2 = RemoveDupes(Split(Text1.Text, " "))

Caption = ""
For i = 0 To UBound(arr2)
Caption = Caption & arr2(i) & " "
Next
End Sub

Public Function RemoveDupes(arr As Variant) As Variant
Dim col As Collection, v As Variant, i As Long, arrResult() As String
On Error Resume Next
Set col = New Collection

' uses the fact that collection doesn't accept items with the same key
For i = 0 To UBound(arr)
If Err Then ' item already exists
Err.Clear
End If
Next

' copy from collection to array
ReDim arrResult(0 To col.Count - 1)
For i = 1 To col.Count
arrResult(i - 1) = col.Item(i)
Next

RemoveDupes = arrResult ' return array
End Function
0

Commented:
write this code

dim Index1 as integer
dim Index2 as integer
dim found as boolean

do while index1<=ubound(arr1)
found=false
if trim(arr1(index1))=trim(arr2(index2)then
found=true
else
index2=index2+1
end if
loop
redim preserve arr2(Ubound(arr2)+1)
arr2(Ubound(arr2)+1) =arr1(index1)
end if
index1=index1+1
loop

0

Author Commented:
Hi experts

thanks for your successfull answers. they are all helpful but I prefer Bahnas's one because it is so short and simple

BUT I think that there is no need for this part :

for I = 1 to UBound (arr1)
sArr =sArr & arr1(I)
next

ray14
0

Commented:
What if first element is "red" and second element is "re"?
Instr will find "re" in sArr, and it won't be added.
0

Commented:
Here is Shorter version of my code:

' Form1, add textbox (Text = "Red Blue Blue Yellow Red Red Blue Green Red")
Option Explicit

Private Sub Text1_Change()
Caption = Join(RemoveDupes(Split(Text1.Text, " ")), " ")
End Sub

Function RemoveDupes(arr As Variant) As Variant
Dim col As New Collection, v As Variant, i As Long, arrR() As String
On Error Resume Next

For Each v In arr
Err.Clear
Next

ReDim arrR(0 To col.Count - 1)
For i = 1 To col.Count
arrR(i - 1) = col.Item(i)
Next
RemoveDupes = arrR
End Function
0

Commented:
thanks for the points
:-)
0

Author Commented:
Thank you ameba for your continuous efforts , realy your comments are right and your solution is nice... I'll use it in my project.
One day I ask another question , if you help me I shall increase the points by + 50 points ... as for this question..

ray14
0

Commented:
Thanks, ray14, maybe that day is today  ;-)
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.