Fastest way to find and count same items VB6

rjef
rjef used Ask the Experts™
on
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

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
View Solution Only
ste5anSenior Developer

Commented:
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

Top Expert 2014
Commented:
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
rjef

Author

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
Ensure you’re charging the right price for your IT

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

Find out now!
rjef

Author

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
rjef

Author

Commented:
figured it out
thanks for not helping.
For Each VBcontain In dicUnique
List8.AddItem VBcontain
Next
ste5anSenior Developer

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

Author

Commented:
I think I closed the ticket instead off giving points.  please open it back up so I can give you credit
aikimark
Top Expert 2014

Commented:
aikimark
Top Expert 2014

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

Commented:
@ste5an

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

Commented:
????

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

Author

Commented:
great job
aikimark
Top Expert 2014

Commented:
@ste5an

I thought you were comparing dictionary to O(N^2) looping code.  I apologize for the misinterpretation of your earlier comment.
ste5anSenior Developer

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

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial