compare and find duplicates in 2 corresponding columns in 2 sheets

Question

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)

What do you mean by "not working well"? You say the code works but you also say that it should delete something which it doesn't...? — arcadeprecinct, Jun 11 '16 at 15:08
I copied your code into an empty Excel file and the code seems to work flawlessly (no errors, bugs, unexpected breaks). So, I can only assume that the above code is not doing what you expect it to do. So, could you please specify (possibly with some sample data) what it should do but doesn't do. Do you want us to write additional code (add to the above code)? — Ralph, Jun 11 '16 at 20:49
Hi @Ralph and arcadeprecinct – the code is running fine, But not doing what I wanted, Not really good in this coding , thus require help to fix this code as per requirement. Thanks — bcool, Jun 12 '16 at 10:35

score 2 · Answer 1 · edited May 08 '18 at 21:49

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"

score 0 · Answer 2 · answered Jun 12 '16 at 15:35

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:

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

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.

compare and find duplicates in 2 corresponding columns in 2 sheets

2 Answers2