Compare multiple column rows on different worksheets.

[dids72]

Hello,

I am trying to figure out how to compare (or if it's possible) the
data from rows across multiple columns on different worksheets. What
I am trying to do is output the data that is in Worksheet 1 and not in
Worksheet 2 into Worksheet 3. Also, output the data that is in
Worksheet 2 but not in Worksheet 1 into Worksheet 4.

For Example:

Worksheet 1
Column A Column B
080107 AN3205
080207 AN3205
080107 AN3500
080107 AN3501
080107 AN3510


Worksheet 2
Column Column B
080107 AN3205
080107 AN3500
080207 AN3501
080107 AN3510


When compared Worksheet 3 would be populated with the following data
since it is in Worksheet 1 and not in Worksheet 2.

Worksheet 3
Column A Column B
80207 AN3205



Worksheet 4 would then be populated with the following data since it
is in Worksheet 2 but not in Worksheet 1.

Worksheet 4
Column A Column B
80207 AN3501



I have the following code that I am trying to figure out how to modify
it to do what I need. As it is coded now it is only comparing whats
in one column to what in another column.

Sub Compare()

Dim LastRow As Integer
Dim CopyTo As Range

' Go to start of data range and get last row number
ActiveSheet.Range("A3").Select
LastRow = ActiveCell.SpecialCells(xlLastCell).Row

' Set start address for outputing unique values
Set CopyTo = Range("C3")

' Begin loop
For Row = 3 To LastRow

' Search column B for duplicate of current cell
' If not duplicate, output to Column C
' If Range("B:B").Find(ActiveCell.Text) Is Nothing Then
If Range("B:B").Find(ActiveCell.Text, lookat:=xlWhole) Is Nothing
Then
CopyTo.Value = ActiveCell.Value
Set CopyTo = CopyTffset(1, 0)
End If

' Move to next cell
ActiveCell.Offset(1, 0).Select

Next



' Go to start of data range and get last row number
ActiveSheet.Range("B3").Select
LastRow = ActiveCell.SpecialCells(xlLastCell).Row

' Set start address for outputing unique values
Set CopyTo = Range("D3")

' Begin loop
For Row = 3 To LastRow

' Search column A for duplicate of current cell
' If not duplicate, output to Column D
If Range("A:A").Find(ActiveCell.Text) Is Nothing Then
CopyTo.Value = ActiveCell.Value
Set CopyTo = CopyTffset(1, 0)
End If

' Move to next cell
ActiveCell.Offset(1, 0).Select

Next

Range("A3").Select

End Sub



Any help you can provide would be greatly appreciated.

Thanks,

DIDS