Solved

Comparing 2 Lists for duplicates

Posted on 2004-10-07
10
324 Views
Last Modified: 2010-05-02
i'm trying to compare 2 lists for duplicates items then split between the "-" and add the number together if its the same item in both lists, each item is listed like this:


list1:
---------
cat-34
snake-4

list2:
--------
lion-11
snake-4

comparing these 2 lists and adding to a new list like this:

list3:
----------
snake-8
lion-11
cat-34

snake was a duplicate, so the numbers after the "-" was added together, and the rest were added too.

this is my code, its not working very well..

Dim i As Long, e As Long

On Error Resume Next

For i = 0 To List2.ListCount - 1

    For e = 0 To List3.ListCount - 1
   
        st = Split(List2.List(i), "-")
       
        ts1 = st(0): ts2 = st(1)
       
        rst = Split(List3.List(e), "-")
       
        rts1 = st(0): rts2 = st(1)
       
    If LCase(ts1) = LCase(rts1) And i <> e Then
   
        s1 = ts2: s2 = rts2: s3 = s1 + s2
       
        List1.AddItem ts1 & "-" & s3
       
    Else
        List1.AddItem List1, List3.List(e)
       
    End If

    Next e
   
Next i




0
Comment
Question by:andyakira
10 Comments
 
LVL 5

Expert Comment

by:gary_j
ID: 12249520


dim l as long 'for list1
dim ll as long 'for list2
dim bFound as boolean
dim astrCk1 as string
dim astrCk2 as string

'move list1 to list 3
for l = 0 to list1.listcount -1
   list3.additem list1.list(l)
next 'l

'move list2 to list3, but check for it first
for l = 0 to list2.listcount-1
   bFound = false
   astrCk1 = split(list2.list(l),"-")

   for ll = 0 to list3.listcount -1
      astrck2 = split(list3.list(ll),"-")
     
      if astrck1(0) = astrck2(0) then
         bfound = true
         list3.list(ll) = astrck1(0) & "-" & cstr(val(astrck2(1)) + val(astrck1(1)))
         exit for
      end if
   next 'll

   if bfound = false then
      list3.additem list2.list(l)
   endif
next 'l
0
 
LVL 17

Expert Comment

by:inthedark
ID: 12250218
How many will be in your list?  There is a fast but easy way to do this using a Disconnected recordset.  Although gary_j 's solution will work it uses visual components to do the compare (a kinda sort).

Private Sub Form_Load()

'create a recordset
Dim RS As ADODB.Recordset
Set RS = New ADODB.Recordset

' create some fields
RS.Fields.Append "Key", adVarChar, 20
RS.Fields.Append "Source", adVarChar, 1
RS.Fields.Append "Count", adInteger


' get the set ready for action
Set RS.ActiveConnection = Nothing
RS.Open

Dim lC As Long

' add the records for list 1
For lC = 1 To 10
    RS.AddNew
    RS("Key") = "Key" + CStr(lC)
    RS("Source") = "1"
    RS("Count") = 0
    RS.Update
Next lC

' add the records for list 2
' missing every other record
' for this test
For lC = 1 To 10 Step 2
    RS.AddNew
    RS("Key") = "Key" + CStr(lC)
    RS("Source") = "2"
    RS("Count") = 0
    RS.Update
Next lC

'========Option 1 - end up with a simple list
' this is where the work is done
' sort the recordset by the key
RS.Sort = "Key"

' now count dupes
If RS.EOF And RS.BOF Then
    MsgBox "No records in either list"
End If

RS.MoveFirst    ' if not records
Dim vLastKeyBookMark
Dim sKey As String
sKey = RS("Key")
vLastKeyBookMark = RS.BookMark

Do
    If RS.EOF Then Exit Do
    RS.MoveNext
    If RS.EOF Then Exit Do
    If RS("Key") = sKey Then
        RS.Delete
        RS.BookMark = vLastKeyBookMark
        RS("Count") = RS("Count") + 1
        RS.Update
    Else
        sKey = RS("Key")
        vLastKeyBookMark = RS.BookMark
    End If
Loop

' now loop through records
' and create the results
RS.MoveFirst
Do While Not RS.EOF
    Debug.Print RS("Key") + " ~ " + CStr(RS("Count") + 1)
    RS.MoveNext
Loop
RS.Close
Set RS = Nothing

End Sub
0
 
LVL 17

Expert Comment

by:inthedark
ID: 12250291
Here is another way for merging using disconnected set.

'========Option 2 - just create output list
' this is where the work is done
' sort the recordset by the key
RS.Sort = "Key"

' now count dupes
If RS.EOF And RS.BOF Then
    MsgBox "No records in either list"
End If

Dim sLast As String
Dim lCount As Long

RS.MoveFirst    ' if not records
Do While Not RS.EOF
    If Len(sLast) > 0 And RS("Key") <> sLast Then
        Debug.Print sLast; " ~ "; lCount
        lCount = 0
    End If
    lCount = lCount + 1
    sLast = RS("Key")
    RS.MoveNext
Loop

' don't forget last record
 Debug.Print sLast; " ~ "; lCount

RS.Close
Set RS = Nothing

End Sub
0
 
LVL 5

Expert Comment

by:gary_j
ID: 12250538
this is my first try ever at disconnected recordsets -- i like it, and think this is more straight-forward maybe

    Dim rs1 As ADODB.Recordset
    Dim l As Long
    Dim astrSource() As String
    Dim bFound As Boolean
   
    Set rs1 = New ADODB.Recordset
    Set rs1.ActiveConnection = Nothing
   
    rs1.Fields.Append "Source", adVarChar, 100
    rs1.Fields.Append "Count", adInteger
   
    rs1.Open
   
    'get list 1 into recordset
   
    For l = 0 To List1.ListCount - 1
        astrSource = Split(List1.List(l), "-")
        rs1.AddNew
        rs1("Source") = astrSource(0)
        rs1("Count") = Val(astrSource(1))
        rs1.Update
    Next 'l
   
    'add or update for list 2
    For l = 0 To List2.ListCount - 1
        astrSource = Split(List2.List(l), "-")
        bFound = False
        rs1.MoveFirst
   
        Do While Not rs1.EOF
            If rs1.Fields("Source").Value = astrSource(0) Then
                bFound = True
                rs1.Fields("Count").Value = _
                    rs1.Fields("Count").Value + Val(astrSource(1))
                Exit Do
            End If
            rs1.MoveNext
        Loop
        If bFound = False Then
            rs1.AddNew
            rs1("Source") = astrSource(0)
            rs1("Count") = Val(astrSource(1))
            rs1.Update
        End If
    Next 'l
   
    'create list3
    rs1.Sort = "Source"
   
    rs1.MoveFirst
   
    Do While Not rs1.EOF
        List3.AddItem rs1("Source") & "-" & CStr(rs1("Count"))
        rs1.MoveNext
    Loop
   
    rs1.Close
   
    Set rs1 = Nothing
0
 
LVL 17

Expert Comment

by:inthedark
ID: 12251110
You are on the right idea here is a tip to make it work faster:

After you loaded list 1 into the recordset:

' Sort the recordset
rs1.Sort="Source" ' sort by field named "Source"


 'add or update for list 2
    For l = 0 To List2.ListCount - 1
        astrSource = Split(List2.List(l), "-")
       
        ' fast find the record we want
        rs1.filter="(Source='" & astrSource(0) & "')"
        if rs1.eof and rs1.bof then
              ' no record yet so add one  
              rs1.AddNew
              rs1("Source") = astrSource(0)
              rs1("Count") = Val(astrSource(1))
              rs1.Update
       else
              ' update the old record
              rs1("Count") = rs1("Count") +  Val(astrSource(1))
              rs1.Update
       end if
    Next

' pull back all the records
rs1.filter =""

' it may need a resort but I don;t think so
rs1.Sort="Source"

' now create output
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 5

Expert Comment

by:gary_j
ID: 12251648
thanks -- i didn't ask the question but i learned something anyhow!

lol

0
 
LVL 85

Accepted Solution

by:
Mike Tomlinson earned 500 total points
ID: 12252406
Here is a completely different approach using a collection to hold your values.  We can do a lookup using the animal as the key:

Option Explicit

Private combinedList As Collection

Private Sub Form_Load()
    ' test data
    List1.AddItem "cat-34"
    List1.AddItem "snake-4"
    List2.AddItem "lion-11"
    List2.AddItem "snake-4"
End Sub

Private Sub Command1_Click()
    Dim i As Integer
    Dim value As Variant
   
    ' clear out the results collection
    Set combinedList = New Collection
   
    ' proces first list
    For i = 0 To List1.ListCount - 1
        addValue List1.List(i)
    Next i
   
    ' process second list
    For i = 0 To List2.ListCount - 1
        addValue List2.List(i)
    Next i
   
    ' display the results in the third list
    List3.Clear
    For Each value In combinedList
        List3.AddItem value
    Next
End Sub

Private Sub addValue(ByVal value As String)
    On Error GoTo AddNewItem
   
    Dim values As Variant
    Dim key As String
    Dim total As Integer
    Dim prevValue As Variant
    Dim prevTotal As Integer
   
    ' parse the input value into the key and the total
    values = Split(value, "-")
    key = CStr(values(0))
    total = Val(values(1))
   
    ' grab the previous total and parse it
    ' (if none exists then we jump to AddNewItem)
    prevValue = combinedList.Item(key)
    values = Split(prevValue, "-")
    prevTotal = Val(values(1))
       
    ' remove the previous total
    combinedList.Remove key
   
    ' add the new total back in
    combinedList.Add key & "-" & (total + prevTotal), key
    Exit Sub
   
AddNewItem:
    ' no previous total...make an entry
    combinedList.Add key & "-" & total, key
End Sub
0
 
LVL 5

Expert Comment

by:gary_j
ID: 12252811
so there's more than one way to skin a cat, lion, snake
0
 

Author Comment

by:andyakira
ID: 12254056
you guys are great, and idle_minds a genious. always comes with a answer that works like a charm.
0
 
LVL 17

Expert Comment

by:inthedark
ID: 12256669
Yup and collections are fast as well!
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

23 Experts available now in Live!

Get 1:1 Help Now