We help IT Professionals succeed at work.

Fastest way to find and count same items VB6

rjef
rjef asked
on
16 Comments
1 Solution
227 Views
Last Modified: 2017-03-23
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

View Solution Only

ste5anSenior Developer
CERTIFIED EXPERT

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

Social distance; Wear a mask; Don't touch your face; Wash your hands for 20 seconds
CERTIFIED EXPERT
Top Expert 2014
Commented:
This problem has been solved!
(Unlock this solution with a 7-day Free Trial)
UNLOCK SOLUTION
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
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
CERTIFIED EXPERT

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
aikimarkSocial distance; Wear a mask; Don't touch your face; Wash your hands for 20 seconds
CERTIFIED EXPERT
Top Expert 2014

Commented:
aikimarkSocial distance; Wear a mask; Don't touch your face; Wash your hands for 20 seconds
CERTIFIED EXPERT
Top Expert 2014

Commented:
thanks for not helping.
If this isn't a typo, please explain how I didn't help.
aikimarkSocial distance; Wear a mask; Don't touch your face; Wash your hands for 20 seconds
CERTIFIED EXPERT
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
CERTIFIED EXPERT

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
aikimarkSocial distance; Wear a mask; Don't touch your face; Wash your hands for 20 seconds
CERTIFIED EXPERT
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
CERTIFIED EXPERT

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

Gain unlimited access to on-demand training courses with an Experts Exchange subscription.

Get Access
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Empower Your Career
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions