Copy Entire rows with a difference

D

DB100

Hi All

I have 2 sheets of data

Sheet 1 and sheet 2 ( with columns a:z - the number of rows varies )

I have a Macro that will pull entries from sheet 2 that are not o
sheet 1 to a new sheet "sheet 3". I have put this below, But I can onl
make this work to pull out the column A.

Does anyone know how to modify this to pullthe entire row to sheet
and not just column A

thanks for any help

David

'
' Macro1 Macro
' Macro recorded 15/11/2004 by DavidBu
'
Sub UniqueList()
'Build a new unique list from two other lists.
'Works by checking list 1 for missing values in list 2.
'Note: List 1 cannot contain duplicates, but list 2 can!
'Standard Module code!
'Sheet1 is the master list of names.
'Sheet2 is the Raw data.
'Sheet3 gets the names that are in the raw data but not on the maste
list!

Set MyFunction = Application.WorksheetFunction
Set MyRange1 = Sheets("Sheet1").Range("A2:A5000")
Set MyRange2 = Sheets("Sheet2").Range("A2:A5000")
Set MyResults = Sheets("Sheet3").Range("A2")

'Loop for list values.
Sheets("Sheet1").Select
For Each cell In MyRange2
On Error GoTo myFin
Sheets("Sheet2").Select
If MyFunction.CountIf(MyRange1, cell.Value) = 0 Then
Sheets("Sheet3").Select
Set MyResults = MyResults.Offset(r, 0)
MyResults.Value = cell.Value
r = r + 1
End If
Next cell

myFin:
Sheets("Sheet3").Select
Sheets("Sheet3").Range("A1").Select

End Su
 
T

Tom Ogilvy

Sub UniqueList()
'Build a new unique list from two other lists.
'Works by checking list 1 for missing values in list 2.
'Note: List 1 cannot contain duplicates, but list 2 can!
'Standard Module code!
'Sheet1 is the master list of names.
'Sheet2 is the Raw data.
'Sheet3 gets the names that are in the raw data but not on the master
list!

Set MyFunction = Application.WorksheetFunction
Set MyRange1 = Sheets("Sheet1").Range("A2:A5000")
Set MyRange2 = Sheets("Sheet2").Range("A2:A5000")
Set MyResults = Sheets("Sheet3").Range("A2")

'Loop for list values.
Sheets("Sheet1").Select
For Each cell In MyRange2
On Error GoTo myFin
Sheets("Sheet2").Select
If MyFunction.CountIf(MyRange1, cell.Value) = 0 Then
Sheets("Sheet3").Select
Set MyResults = MyResults.Offset(r, 0)
cell.EntireRow.copy
MyResults.PasteSpecial xlValues
r = r + 1
End If
Next cell

myFin:
Sheets("Sheet3").Select
Sheets("Sheet3").Range("A1").Select

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top