Search and display array results

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

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

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

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."

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

Yuval, how did you manage to put an array into a text box?

Yes,

I am curious about the same thing. Please advise.

jjjjjjj

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


Cheers!

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!  

Thanks