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

rjefAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

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

ste5anSenior DeveloperCommented:
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

0
aikimarkCommented:
Yes
1. Use a dictionary object - createobject("scripting.dictionary")
2. Single iteration through your list
If dicUnique.Exists(List1.List(zz1)) Then
    dicUnique(List1.List(zz1)) = dicUnique(List1.List(zz1)) + 1
Else
    dicUnique(List1.List(zz1)) = 1
End If

Open in new window

3. Not sure what you want to do with the items and counts, but they are there in the dictionary object

More information on the dictionary object can be found in this excellent article:
https://www.experts-exchange.com/articles/3391/Using-the-Dictionary-Class-in-VBA.html
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
rjefAuthor Commented:
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
0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

rjefAuthor Commented:
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
0
rjefAuthor Commented:
figured it out
thanks for not helping.
For Each VBcontain In dicUnique
List8.AddItem VBcontain
Next
0
ste5anSenior DeveloperCommented:
Using a dictionary does not speed up the original procedure.. especially as the proposed one constructs a completely different list..
0
rjefAuthor Commented:
I think I closed the ticket instead off giving points.  please open it back up so I can give you credit
0
aikimarkCommented:
thanks for not helping.
If this isn't a typo, please explain how I didn't help.
0
aikimarkCommented:
@ste5an

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

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

0
rjefAuthor Commented:
great job
0
aikimarkCommented:
@ste5an

I thought you were comparing dictionary to O(N^2) looping code.  I apologize for the misinterpretation of your earlier comment.
0
ste5anSenior DeveloperCommented:
Nope. I just tried to point out, that my approach already increased performance, while keeping the original logic.
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
vb6

From novice to tech pro — start learning today.