Link to home
Start Free TrialLog in
Avatar of rjef
rjefFlag for United States of America

asked on

Fastest way to find and count same items VB6

is there a faster way to do this in VB6?
For zz1 = 0 To List1.ListCount - 1
  DoEvents
gg = ""
gg = List1.List(zz1)
    For zz2 = zz1 To List1.ListCount - 1
        If gg = List1.List(zz2) And gg <> "" Then
            countit = countit + 1
            List1.List(zz2) = ""
        End If
    Next zz2
        If countit <> 0 Then
            List2.AddItem gg & "," & countit
            countit = 0
        End If
Next zz1

Open in new window

Avatar of ste5an
ste5an
Flag of Germany image

DoEvents can consume much time and you enter the inner loop when it isn't necessary. This should be slightly faster:

countit = 0
For zz1 = 0 To List1.ListCount - 1
    gg = List1.List(zz1)
    If gg <> "" Then
        For zz2 = zz1 To List1.ListCount - 1
            If gg = List1.List(zz2)  Then
                countit = countit + 1
                List1.List(zz2) = ""
            End If
        Next zz2

        If countit <> 0 Then
            List2.AddItem gg & "," & countit
            countit = 0
        End If
    End If
Next zz1

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of aikimark
aikimark
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of rjef

ASKER

like this?  It comes out empty

Dim dicUnique As New Dictionary ' = CreateObject("Scripting.Dictionary")


For zz1 = 0 To List1.ListCount - 1
DoEvents

If dicUnique.Exists(List1.List(zz1)) Then
    dicUnique(List1.List(zz1)) = dicUnique(List1.List(zz1)) + 1
Else
    dicUnique(List1.List(zz1)) = 1
End If
Next zz1
For zz = 1 To 100
MsgBox dicUnique(zz)
Next zz
Avatar of rjef

ASKER

I have the count but I need to know the item with the count (list1.list(??))
so how do I get the item and conunbt
Dim dicUnique As Dictionary
Dim VBcontain
Set dicUnique = New Dictionary
For zz1 = 0 To List1.ListCount - 1
DoEvents
If dicUnique.Exists(List1.List(zz1)) Then
    dicUnique(List1.List(zz1)) = dicUnique(List1.List(zz1)) + 1
Else
    dicUnique(List1.List(zz1)) = 1
End If
Next zz1
For xxx = 1 To 905
List7.AddItem dicUnique.Items(xxx)
Next xxx
Avatar of rjef

ASKER

figured it out
thanks for not helping.
For Each VBcontain In dicUnique
List8.AddItem VBcontain
Next
Using a dictionary does not speed up the original procedure.. especially as the proposed one constructs a completely different list..
Avatar of rjef

ASKER

I think I closed the ticket instead off giving points.  please open it back up so I can give you credit
thanks for not helping.
If this isn't a typo, please explain how I didn't help.
@ste5an

Measure it yourself and see the performance difference.  Don't take my word on it.  Please avoid statements/assertions that aren't true.
????

It's ~ 90 seconds vs 12 seconsds..

Private Declare Function GetTickCount Lib "kernel32.dll" () As Long

Private Sub Command1_Click()
    Dim Ticks As Long
    Ticks = GetTickCount
    
    For zz1 = 0 To List1.ListCount - 1
        DoEvents
        gg = ""
        gg = List1.List(zz1)
        For zz2 = zz1 To List1.ListCount - 1
            If gg = List1.List(zz2) And gg <> "" Then
                countit = countit + 1
                List1.List(zz2) = ""
            End If
        Next zz2
        
        If countit <> 0 Then
            List2.AddItem gg & "," & countit
            countit = 0
        End If
    Next zz1
    
    Ticks = GetTickCount - Ticks
    MsgBox Ticks / 1000
End Sub

Private Sub Command2_Click()
    Dim Ticks As Long
    Ticks = GetTickCount
    
    countit = 0
    For zz1 = 0 To List1.ListCount - 1
        gg = List1.List(zz1)
        If gg <> "" Then
            For zz2 = zz1 To List1.ListCount - 1
                If gg = List1.List(zz2) Then
                    countit = countit + 1
                    List1.List(zz2) = ""
                End If
            Next zz2
    
            If countit <> 0 Then
                List2.AddItem gg & "," & countit
                countit = 0
            End If
        End If
    Next zz1

    Ticks = GetTickCount - Ticks
    MsgBox Ticks / 1000
End Sub

Private Sub Command3_Click()
    List1.Clear
    List2.Clear
    For i = 1 To 10000
      List1.AddItem CInt(Rnd * 100)
    Next i
End Sub

Open in new window

Avatar of rjef

ASKER

great job
@ste5an

I thought you were comparing dictionary to O(N^2) looping code.  I apologize for the misinterpretation of your earlier comment.
Nope. I just tried to point out, that my approach already increased performance, while keeping the original logic.