CODEWITHSUNDEEP
vbaexcel
bcool
bcool

Reputation: 3

compare and find duplicates in 2 corresponding columns in 2 sheets

I wants to compare (500) and find duplicate daily records within 2 sheets, and copy the unmatched row to another sheet, copy the match from another to 3rd sheet, and delete the matched records from original sheet.

I have 3 worksheets(results, Master List, Follow Ups) " results" update daily with 500 records, and added to "master list", duplicate row added to "follow ups"

All have similar columns heading A to O.

I wants to compare Column B (unique) and column A of worksheet "results" to " Master List" flow would be- Match a first cell value in column B of "results" to Column B cell values of " Master List" If match found - compare column A of "results" to Column A cell values of " Master List" if match found Copy the row of Match from "Master List" for Column A to O to Next available row of "FOllow Ups" And mark the match row in "results" to be deleted in the end when search loop finished

Else if match not found check next value in column B of " result" until last record

when whole search end delete marked records for match found in "results" and copy all the left out records to Next available table row in "Master List"

I am kind of stuck and don't want to run in long loop, looking for expert help with shortest and fastest possible code. Here is some code already written and working, but not working well. Thanks in advance for your help.

Set sht1 = xlwb.Worksheets("results")
Set sht4 = xlwb.Worksheets("Master List")
Set sht5 = xlwb.Worksheets("Follow Ups")

For i = 2 To sht1.Range("A1").SpecialCells(xlCellTypeLastCell).Row
    For j = 2 To sht4.Range("A1").SpecialCells(xlCellTypeLastCell).Row
        If sht1.Cells(i, 2) = sht4.Cells(j, 2) And sht1.Cells(i, 1) = sht4.Cells(j, 1) Then
            'sht4.Rows(j).Copy
            ' sht5.Activate
            'sht5.Cells(1, sht5.Range("A1").SpecialCells(xlCellTypeLastCell).Row).Select
            sht4.Rows(j).Copy _
                Destination:=sht5.Cells(sht5.Range("A1").SpecialCells(xlCellTypeLastCell).Row + 1, 1)
            'sht1.Rows(i).Delete
            'i = i - 1
        End If
    Next j
Next i

sht1.Range("A2:O" & sht1.Range("A1").SpecialCells(xlCellTypeLastCell).Row).Copy _
    Destination:=sht4.Cells(sht4.Range("A1").SpecialCells(xlCellTypeLastCell).Row, 1)

Upvotes: 0

Views: 284

Answers (2)

Parfait
Parfait

Reputation: 107567

Consider an SQL solution (assuming you use Excel for PC) as Excel can run an ODBC connection on a workbook using the Jet/ACE SQL engine (Windows .dll files). No looping or if/then logic across cells are used here for a scalable, efficient solution. Essentially you would run two queries:

  1. MATCHES: an inner join query on Results and MasterList worksheet with results appended to Follow-Ups 
    SELECT r.* FROM [Results$] r
    INNER JOIN [MasterList$] m
    ON r.ColA = m.ColA AND r.ColB = m.ColB
  1. NON-MATCHES: a left join null query on Results and MasterList worksheet with results appended to MasterList 
    SELECT r.* FROM [Results$] r
    LEFT JOIN [MasterList$] m
    ON r.ColA = m.ColA AND r.ColB = m.ColB
    WHERE m.ColA IS NULL;

VBA Script (two connections included for Driver/Provider versions)

Sub RunSQL()
On Error GoTo ErrHandle
    Dim conn As Object, rst As Object
    Dim strConnection As String, strSQL As String
    Dim i As Integer
    Dim fLastRow As Integer, mLastRow As Integer

    Set conn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")

    ' Hard code database location and name
'    strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
'                      & "DBQ=C:\Path\To\Workbook.xlsm;"
    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                       & "Data Source='C:\Path\To\Workbook.xlsm';" _
                       & "Extended Properties=""Excel 8.0;HDR=YES;"";"

    ' OPEN DB CONNECTION
    conn.Open strConnection

    ''''''''''''''''''''''''''''''''''''
    ''' FOLLOW-UPS (MATCHED) DATA
    ''''''''''''''''''''''''''''''''''''
    strSQL = " SELECT r.* FROM [RESULTS$] r" _
              & " INNER JOIN [MASTERLIST$] m" _
              & " ON r.ColA = m.ColA AND r.ColB = m.ColB"

    ' OPEN QUERY RECORDSET
    rst.Open strSQL, conn

    ' COPY DATA TO WORKSHEET
    fLastRow = Worksheets("FOLLOW-UPS").Cells(Worksheets("FOLLOW-UPS") _
                          .Rows.Count, "A").End(xlUp).Row
    Worksheets("FOLLOW-UPS").Range("A" & fLastRow + 1).CopyFromRecordset rst
    rst.Close

    ''''''''''''''''''''''''''''''''''''
    ''' MASTERLIST (UNMATCHED) DATA
    ''''''''''''''''''''''''''''''''''''
    strSQL = " SELECT r.* FROM [RESULTS$] r" _
              & " LEFT JOIN [MASTERLIST$] m" _
              & " ON r.ColA = m.ColA AND r.ColB = m.ColB" _
              & " WHERE m.ColA IS NULL;"

    ' OPEN QUERY RECORDSET
    rst.Open strSQL, conn

    ' COPY DATA TO WORKSHEET
    mLastRow = Worksheets("MASTERLIST").Cells(Worksheets("MASTERLIST") _
                          .Rows.Count, "A").End(xlUp).Row
    Worksheets("MASTERLIST").Range("A" & mLastRow + 1).CopyFromRecordset rst

    rst.Close
    conn.Close

    MsgBox "Successfully processed SQL queries!", vbInformation
    Exit Sub

ErrHandle:
    MsgBox Err.Number & " = " & Err.Description, vbCritical
    Exit Sub
End Sub

Demo

Here is a Dropbox xlsm file demonstration using Shakespearan Characters where MasterList carries popular female characters and Results are small batch of female/male characters. Press SQL button to run macro. Once query is processed, females (matches) output to Follow-Ups and males (non-matches) append to MasterList. Be sure to adjust Workbook path in string ODBC connection.

Upvotes: 0

Martin Carlsson
Martin Carlsson

Reputation: 471

Doing what you do here will give significant performance problems if you have "a lot" of data. The problem is that every time you move data from Excel to VBA the is an overhead. What you should do here is to copy all your data one time to arrays (see http://www.cpearson.com/excel/ArraysAndRanges.aspx) and do all your logic in VBA without touching your Excel sheets.

If you still needs a performance boost you should look in to dictionaries (see Does VBA have Dictionary Structure?).

Read this article: https://msdn.microsoft.com/en-us/library/office/ff726673.aspx Especially the segment "Read and Write Large Blocks of Data in a Single Operation"

Upvotes: 2

Related Questions