Search and display array results

I have an one dimensional array:

dim x(1 to 10) as string
I have populated the array with single character string values:
asdfgasdqw

I want to now search the array and find duplicates within the array without using another array as the "target".  I believe that I can use the instr() function but cannot get it to work.  Once I find duplicates, I want to count how many times the value appears in the array and display as follows:

a 2, s 2, d 2, f 1, g 1, q 1,w 1 (per the example above)

Thanks for the help
jjjjjjj

LVL 1
jjjjjjjAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

VbmasterCommented:
Using a extra array is way more efficient but since you don't want it that way here's code how to do it the way you want it (I guess...).

  Dim Result As String
  Dim Char As String * 1
  Dim Count As Integer
  Dim a As Integer
  Dim b As Integer

  For a = 1 To 10
    Char = x(a)
    If (InStr(Result, Char) = 0) Then
      Count = 0
      For b = a To 10
        If (x(b) = Char) Then
          Count = Count + 1
        End If
      Next
      Result = Result & Char & " " & Count & " , "
    End If
  Next
  Result = Left$(Result, Len(Result) - 3)
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Erick37Commented:
Vbmaster's code "cheats" just a little by using
 If (InStr(Result, Char) = 0) Then...
This is in effect another buffer used to retain the results.
You may also have problems if your array contains a comma, or space character.

The following code does not use any secondary buffer, but it is less efficient.

Private Sub Command1_Click()
    Dim x
    Dim i As Integer, j As Integer, k As Integer
    Dim Count As Long
    Dim bInArray As Boolean
    'asdfgasdqw
    x = Array("a", "s", "d", "f", "g", "a", "s", "d", "q", "w")
    'Main loop thru entire array
    For i = LBound(x) To UBound(x)
        Count = 0
        bInArray = False
        'First check backwards to see if x(k)
        'letter already is in the array
        'so we do not count it twice
        For k = i - 1 To LBound(x) Step -1
            If k < LBound(x) Then Exit For
            If x(i) = x(k) Then
                bInArray = True
            End If
        Next
        'Next check forward to count the number of times
        'x(i) is in the rest of the array
        For j = i To UBound(x)
            If bInArray Then Exit For
            If x(i) = x(j) Then
                Count = Count + 1
            End If
        Next
        'Print results only if a unique
        'x(i) was found
        If Not bInArray Then
            Debug.Print x(i) & " " & Count
        End If
    Next
           
End Sub
0
mdouganCommented:
Well, I don't know if this solution meets the criteria not to create a second array, but this is a pretty slick function, that I believe might be new to VB 6:

Dim i As Integer
Dim x As Variant
Dim y As Variant
x = Array("a", "s", "d", "f", "g", "a", "s", "d", "q", "w")
For i = 0 To UBound(x) - 1
    y = Filter(x, x(i), True, vbTextCompare)
    If UBound(y) > 0 Then
        MsgBox x(i) & " is a duplicate"
    End If
    Erase y
Next i
0
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

mdouganCommented:
Opps, lets put this in the format that the question asked for:

Dim i As Integer
Dim x(1 To 10) As String
Dim y As Variant
x(1) = "a"
x(2) = "s"
x(3) = "d"
x(4) = "f"
x(5) = "g"
x(6) = "a"
x(7) = "s"
x(8) = "d"
x(9) = "q"
x(10) = "w"

For i = 1 To UBound(x)
    y = Filter(x, x(i), True, vbTextCompare)
    Print x(i) & UBound(y) + 1 & " ";
    Erase y
Next i
0
Erick37Commented:
Yes, it is new in VB6.

"Filter Function - returns a zero-based array containing a subset of a string array based on a specified filter criteria."
0
vbyuvalCommented:
Try this simple code :

Private Sub Command1_Click()

Dim CountTimes As Long, StartAt As
    Long, PlaceAt As Long
   
If txtDest = "" Then Exit Sub
StartAt = 1
Do While True
 'txtSource is the text box with the  
 'array
 'txtDest is the text box with the char
PlaceAt = InStr(StartAt, txtSource,  
  txtDest)
If PlaceAt = 0 Then
  'If string not found
   Exit Do
Else
   CountTimes = CountTimes + 1
   StartAt = PlaceAt + 1
   'Start the next search from char
   'number StartAt.
End If

Loop
   
MsgBox CountTimes
   
End Sub


                            Enjoy
                          Yuval Amir
0
Erick37Commented:
Yuval, how did you manage to put an array into a text box?
0
jjjjjjjAuthor Commented:
Yes,

I am curious about the same thing. Please advise.

jjjjjjj
0
mcriderCommented:
If you're interrested I have code that will sort an array, and then search the sorted array for duplicates...


Cheers!
0
cymbolicCommented:
See, we at heart really like to code things rather than push obtuse objects around (me too!), so here's another variant:
dim x$, i as integer
x$=string$(255,0)
for i=1 to ubound(Myarray)
 mid$(x$,asc(MyArray(i)),1)=char$(mid$(x$),asc(MyArry(i)),1)+1)
next i
for i=1 to len(x$)
 if asc(mid$(x$,i,1))>0 then
   print char$(i)+" "+format$(Asc(mid(x$,i,1))
 endif
next i

'works by adding # occurrences (max 255) as a character value in the ascii string position of the character found.  Now see if you can make an even shorter solution!  
0
jjjjjjjAuthor Commented:
Thanks
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.