Compare two lists & save duplicates to new sheet

[compressor]

The Master list:
Sheet1, Column C has unique numbers, i.e, 0608-211-1093-2.

(can have thousands of entries)

The Comparison list:
Sheet2, Column C will have duplicates of some of Sheet1, Column C numbers.

(Sheet2, Column C will have the numbers but other columns will have different
data than Sheet1 and may have a few hundred entries or less)

I need a macro that will that will compare the two sheets for duplicates based on
Column C and then write the entire row of Sheet1 with the duplicate number to a new Sheet3.

 

[BrianB]

Hopefully you can adapt this. Also may need to change the check on all worksheets to just the one you want.

http://www.mrexcel.com/forum/showthread.php?t=143189

 

[compressor]

Thank you for your input. However I am a novice at VBA and macros
and am unable to modify your code for my needs.
I spent the weekend trying to figure it out but only confused myself
and had no success.

Would you be able to explain what lines I need to modify to accomplish
my task as detailed?

 

[xenou]

Not a full-blown solution here but one idea:

Copy Data from Sheet 1 to Sheet 2 (at the bottom), with the key data in the same column of course. You must have an identifier in a column as well, so that you know which sheet each row came from.

Sort the merged data. Or filter for duplicates.

Take all the duplicates that came from Sheet1 (you'll know because you added an identifier in one of the columns) and copy to a new sheet (easy enough if you've filtered for dupes and Sheet 1).

You'd may want to do all these on a backup copy of all the data.

I use the EasyFilter Add-in for finding dupes quite a lot.
Link available here: http://www.mrexcel.com/forum/showthread.php?t=126629

This may work as a quick and dirty for you. Regards.

 

[compressor]

Alexander,

I did try your method but unfortunately the EasyFilter Unique-Duplicates does not copy all the columns.
Only the information in the selected column is copied when using Unique-Duplicates.
A quick read of the manual confirms this to be the case.
And it filters out the duplicates. I want to KEEP the duplicates and filter out the uniques.
EasyFilter may come in handy in other situations.
Thanks for your input.

So I am still looking for a macro solution.

 

[xenou]

Yes, that is correct with regard to filtering only a single column. It took me about 2 months to figure that out (I didn't read the manual). Also, you must have an empty row above the data.

However, there is a functionality for "unique or duplicate" that can be chosen from the bottom drop down list (when on the unique-duplicate) tab - this copies the data to a new workbook in its entirety, and will leave all rows but add a new column to mark them as unique or duplicate. This is very handy sometimes - though I've found it too slow with large sets of data (over 2000 rows).

Regards.

 

[xenou]

I tried this but it doesn't work.

Does anyone know if it is possible to use VLookup in memory with arrays? I thought it was but the code fails on the worksheetfunction - "unable to get the property of the worksheet function class.

Sub Test()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1
Dim ws2
Dim x As Long
Dim varTest
Dim var1
Dim var2
Dim LRow As Long
Dim i
Dim j

'References
Set wb1 = ActiveWorkbook
Set wb2 = ActiveWorkbook
Set ws1 = wb1.Sheets("Sheet1")
Set ws2 = wb2.Sheets("Sheet2")

'Create Array of Sheet1 values
With ws1
    LRow = .Cells(Rows.Count, "C").End(xlUp).Row
    var1 = .Range(.Cells(1, "C"), .Cells(LRow, "C")).Value
End With

For i = 1 To UBound(var1, 1)
    Debug.Print "1|" & var1(i, 1)
Next i

'Create Array of Sheet2 values
With ws2
    LRow = .Cells(Rows.Count, "C").End(xlUp).Row
    var2 = .Range(.Cells(1, "C"), .Cells(LRow, "C")).Value
End With

For i = 1 To UBound(var1, 1)
    Debug.Print "2|" & var1(i, 1)
Next i


'Use vlookup to find duplicates
For i = 1 To UBound(var1, 1)
    varTest = WorksheetFunction.VLookup(var1(i, 1), var2, 1, 0)
Next i

End Sub

 

[xenou]

Here's my latest attempt - forget VLookup!

Oddly enough, out of habit I created this with very flexible references (ws1, ws2, wb1, wb2), and then went and hardcoded the ranges --"Sheet1", Cells(1,"C"), etc.-- normally I shy away from such hard references (what if you added a column or changed a sheet name?, or started the data in a row besides row 1?

Also, I assume you mean "Sheet1" and not Sheet1 (which could be two different things - the first is the sheet name as seen on the tab) so edit if needed.

Option Base 1
Sub CopyDupesToNewSheet()
'To copy rows from "Sheet1" to a new sheet _
'when there are dupes in "Sheet1", Column C of values in "Sheet2", column C

'This module must have an Option Base 1 declaration before any subs

'Variables
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim newSheet As Worksheet
Dim var1Array
Dim var2Array
Dim i As Long
Dim j As Long
Dim x As Long
Dim blnMatch As Boolean
Dim LRow As Long

'References
Set wb1 = ActiveWorkbook
Set wb2 = ActiveWorkbook
Set ws1 = wb1.Sheets("Sheet1")
Set ws2 = wb2.Sheets("Sheet2")
Set newSheet = Workbooks.Add.Sheets(1)

'-------------------------------
'create array - Rows 1 to Last Row, column C
'Do not include headers in this range!!!
With ws1
    LRow = .Cells(Rows.Count, "C").End(xlUp).Row
    var1Array = .Range(.Cells(1, "C"), .Cells(LRow, "C")).Value
End With

'create array - Rows 1 to Last Row, column C
'Do not include headers in this range!!!
With ws2
    LRow = .Cells(Rows.Count, "C").End(xlUp).Row
    var2Array = .Range(.Cells(1, "C"), .Cells(LRow, "C")).Value
End With

'-------------------------------
For i = 1 To UBound(var1Array, 1)
      
    'Test for Matches
    j = 1
    blnMatch = False
    Do While j <= UBound(var2Array, 1) And blnMatch = False
        If var2Array(j, 1) = var1Array(i, 1) Then
            blnMatch = True
            Exit Do
        End If
        j = j + 1
    Loop
    
    'Copy Dupes
    If blnMatch = True Then
        x = x + 1
        ws1.Cells(i, 1).EntireRow.Copy
        newSheet.Cells(x, 1).PasteSpecial
    End If

Next i
'-------------------------------


Application.CutCopyMode = False

End Sub

 

[compressor]

Alexander,

Thank you very much! Your latest code works!
Your efforts will have the end result of helping many
people who have run into financial difficulties.

I would have responded sooner but my main computer died
and is in the process of being fixed.

Again, many thanks!

 

[erik.van.geit]

Alexander,

Take a look at the function MATCH: that will spare you the inner loop.
And while we are at it, compressor<SCRIPT type=text/javascript> vbmenu_register("postmenu_1465096", true); </SCRIPT>, why not simply use an extra column with a MATCH-function, then filter and copy. (this could be automatised)

kind regards,
Erik