Avatar of rjef
rjef
Flag 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

* vb6Visual Basic Classic

Avatar of undefined
Last Comment
ste5an

8/22/2022 - Mon
ste5an

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
aikimark

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
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
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
This is the best money I have ever spent. I cannot not tell you how many times these folks have saved my bacon. I learn so much from the contributors.
rwheeler23
rjef

ASKER
figured it out
thanks for not helping.
For Each VBcontain In dicUnique
List8.AddItem VBcontain
Next
ste5an

Using a dictionary does not speed up the original procedure.. especially as the proposed one constructs a completely different list..
rjef

ASKER
I think I closed the ticket instead off giving points.  please open it back up so I can give you credit
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
aikimark

aikimark

thanks for not helping.
If this isn't a typo, please explain how I didn't help.
aikimark

@ste5an

Measure it yourself and see the performance difference.  Don't take my word on it.  Please avoid statements/assertions that aren't true.
Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!
Walt Forbes
ste5an

????

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

rjef

ASKER
great job
aikimark

@ste5an

I thought you were comparing dictionary to O(N^2) looping code.  I apologize for the misinterpretation of your earlier comment.
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
ste5an

Nope. I just tried to point out, that my approach already increased performance, while keeping the original logic.