Solved

create an unique array

Posted on 2002-04-17
12
175 Views
Last Modified: 2010-05-02
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)

Thanx in advance.
ray14
0
Comment
Question by:ray14
  • 5
  • 3
  • 2
  • +2
12 Comments
 
LVL 100

Expert Comment

by:mlmcc
ID: 6948544
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
  if not found
    redeimension arr2 to current size +1
    set max element of arr2 to arr1(x)

arr2 now has the unique values in arr1
 

mlmcc
0
 
LVL 15

Expert Comment

by:ameba
ID: 6948570
' Form1 code, add textbox
Option Explicit

Private Sub Form_Load()
    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
        col.Add arr(i), "k" & arr(i)
        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
 
LVL 3

Accepted Solution

by:
Bahnass earned 50 total points
ID: 6948581
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
 
LVL 3

Expert Comment

by:Bahnass
ID: 6948583
too slow
:-)
0
 
LVL 15

Expert Comment

by:ameba
ID: 6948713
OOPS, small looping error "0 To UBound(arr) - 1"    :-)

' Form1 code, add textbox
Option Explicit

Private Sub Form_Load()
    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)
        col.Add arr(i), "k" & arr(i)
        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
 

Expert Comment

by:RAJz
ID: 6948801
write this code

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

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

0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 

Author Comment

by:ray14
ID: 6949042
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
 
LVL 15

Expert Comment

by:ameba
ID: 6949138
What if first element is "red" and second element is "re"?
Instr will find "re" in sArr, and it won't be added.
0
 
LVL 15

Expert Comment

by:ameba
ID: 6949162
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
       col.Add v, "k" & v
       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
 
LVL 3

Expert Comment

by:Bahnass
ID: 6949766
thanks for the points
:-)
0
 

Author Comment

by:ray14
ID: 6954942
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
 
LVL 15

Expert Comment

by:ameba
ID: 6961471
Thanks, ray14, maybe that day is today  ;-)
0

Featured Post

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now