Copy rows from one table to another without creating duplicates - excel

Question

I have an Excel workbook that has a master sheet that keeps track of items and their current location, and another sheet that keeps track of past locations or where an item has been. Currently when a record is changed in the master sheet, the row is manually copied and pasted into the 2nd sheet. I would like to create a macro that would find items in the master sheet that are not in the 2nd sheet and copy them to the 2nd sheet when records change.
Below is a sample macro I found and modified that is close, but it copies and pastes all rows instead of the new or different ones. The rows would only need to be compared on columns A, B, and D.
Public Sub Sample()
Dim shM As Worksheet, sh2 As Worksheet
Dim shMData As Variant
Dim sh2DataA As Variant
Dim sh2Data As Variant
Dim iM As Long, os2 As Long, i2 As Variant
Dim DoSearch As Boolean
Set shM = Sheets(1)
Set sh2 = Sheets(2)
With shM
shMData = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 4)
End With
DoSearch = False
For iM = 2 To UBound(shMData, 1)
With sh2
sh2DataA = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 1)
sh2Data = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 4)
End With
os2 = 0
Do
If UBound(shMData, 1) > 1 Then
i2 = Application.Match(shMData(iM, 1), sh2DataA, 0)
Else
If shMData(iM, 1) = sh2DataA Then
i2 = 1
Else
i2 = CVErr(xlErrNA)
End If
End If
If Not IsError(i2) Then
If (shMData(iM, 2) = sh2Data(i2, 2)) And (shMData(iM, 4) = sh2Data(i2, 4)) Then
MsgBox "Match found Master = " & iM & ", sheet2 = " & i2 + os2
Else
shM.Activate
shM.Range(Cells(iM, 1), Cells(iM, 7)).Select
Selection.Copy
sh2.Select
FinalRow = Range("A65536").End(xlUp).Row
NextRow = Range("A65536").End(xlUp).Row + 1
Range("A" & NextRow).Select
ActiveSheet.Paste
End If
os2 = os2 + i2
If os2 < UBound(sh2Data, 1) Then
With sh2
sh2DataA = .Range(.Cells(i2 + os2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 1)
sh2Data = .Range(.Cells(i2 + os2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 4)
End With
DoSearch = True
Else
DoSearch = False
End If
Else
shM.Activate
shM.Range(Cells(iM, 1), Cells(iM, 7)).Select
Selection.Copy
sh2.Select
FinalRow = Range("A65536").End(xlUp).Row
NextRow = Range("A65536").End(xlUp).Row + 1
Range("A" & NextRow).Select
ActiveSheet.Paste
DoSearch = False
End If
Loop Until Not DoSearch
Next
End Sub
The message box was added only to verify that the code was working - it is not a necessary component. Thanks again for any advice you can give.

Answer 1

Assuming you never get two rows of the exact same thing in your master list, you can just use the built-in Excel feature Remove Duplicates (on the Data tab in 2010 at least). If you have x duplicate rows, all the same, x-1 of them are deleted. So, you could just copy the entire other table, paste it below the master list, and then run remove duplicates on the master list. All you need to know is the VBA for removing duplicates.
ActiveSheet.Range("$A$40:$D$43").RemoveDuplicates Columns:=Array(1, 3, 4), Header:=xlNo
Adjust as necessary

Answer 2

Thank you all for your help I found a solution however it does not work in Excel 2003. If anyone knows off the top of their head why that would be great else I think I figure it out. Here is the code.
[HTML]Public Sub NewEntWhole()
Dim loM As ListObject, lo2 As ListObject
Dim TblMData As Variant
Dim iM As Long
Dim dDate As Date
Dim strDate As String
Dim lDate As Long
Dim rng As Range
Dim ct As Variant
Dim shM As Worksheet
Dim sh2 As Worksheet
Dim hdM As Integer
hdM = 0 'rows above table M
Set shM = Sheets(1)
Set sh2 = Sheets(2)
Set loM = Sheets(1).ListObjects(1)
Set lo2 = Sheets(2).ListObjects(1)
With loM
TblMData = .DataBodyRange
End With
For iM = 2 To UBound(TblMData, 1) + 1
sh2.Activate
With lo2
.Range.AutoFilter Field:=1, Criteria1:=loM.Range(iM, 1).Value
.Range.AutoFilter Field:=2, Criteria1:=loM.Range(iM, 2).Value
If IsDate(loM.Range(iM, 4)) Then
sDate = loM.Range(iM, 4)
dDate = DateSerial(Year(sDate), Month(sDate), Day(sDate))
lDate = dDate
.Range.AutoFilter Field:=4, Criteria1:=">=" & lDate, Operator:=xlAnd, Criteria2:="<" & lDate + 1
Else
.Range.AutoFilter Field:=4, Criteria1:=loM.Range(iM, 4).Value
End If
End With
Set rng = lo2.AutoFilter.Range
ct = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
If ct = 0 And loM.Range(iM, 1).Value > 0 Then
shM.Activate
shM.Range(Cells((iM + hdM), 1), Cells((iM + hdM), 7)).Copy
sh2.Activate
FinalRow = Range("B65536").End(xlUp).Row
NextRow = Range("B65536").End(xlUp).Row + 1
Range("A" & NextRow).Select
ActiveSheet.Paste
End If
With lo2
.Range.AutoFilter Field:=1
.Range.AutoFilter Field:=2
.Range.AutoFilter Field:=4
End With
Next
shM.Activate
End Sub[/HTML]