Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 346
  • Last Modified:

Comparing 2 Lists for duplicates

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
andyakira
Asked:
andyakira
1 Solution
 
gary_jCommented:


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
 
inthedarkCommented:
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
 
inthedarkCommented:
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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
gary_jCommented:
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
 
inthedarkCommented:
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
 
gary_jCommented:
thanks -- i didn't ask the question but i learned something anyhow!

lol

0
 
Mike TomlinsonMiddle School Assistant TeacherCommented:
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
 
gary_jCommented:
so there's more than one way to skin a cat, lion, snake
0
 
andyakiraAuthor Commented:
you guys are great, and idle_minds a genious. always comes with a answer that works like a charm.
0
 
inthedarkCommented:
Yup and collections are fast as well!
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now