compare ranges in different workbooks and copy "not matching values" at bottom of range 1
 

hi ,

I am trying to compare data in two different workbooks.it should
compare data in A column in book 1 with data in data in A column in
book 2.

if there is no match, then it should add those data not matched into
book1 at the last of A column.

here is my code:

Sub master()

Dim b1 As Workbook

Dim w1 As Worksheet

Dim rCell As Range
Dim LookRange As Range
Application.ScreenUpdating = False

MsgBox ("Select the Subset File location")

Set b1 = Workbooks.Open(Application.GetOpenFilename(, , "Open File
1"))
Set w1 = b1.Worksheets("suppliers")

Set LookRange = Sheets("suppliers").Range("A1",
Range("A65536").End(xlUp))

MsgBox LookRange.Address

For Each rCell In LookRange


' here it give script out of range error.!!!!???????

If WorksheetFunction.CountIf _
(Sheets("pros").Columns(1), rCell.Text) = 0 Then
rCell.Range("A2:C1").Copy _
Destination:=Sheets("pros").Range("A65536").End(xl Up).Offset(1, 0)

End If

Next rCell

Application.CutCopyMode = False

Application.ScreenUpdating = True

Sheets("pros").Range("A1:A65536").HorizontalAlignm ent = xlRight

Sheets("prols").Activate

End Sub


can anyone help in this..?

thanks,

kaza

compare ranges in different workbooks and copy "not matching values" at bottom of range 1
 

Kaza,

I have a utility that I will send you: it's an add-in that will add a button
to the tools menu, where you can select two worksheets to compare based on
key values in one column: all other differences will be highlighted.

HTH,
Bernie
MS Excel MVP

"Kaza Sriram" wrote in message
om...
hi ,

I am trying to compare data in two different workbooks.it should
compare data in A column in book 1 with data in data in A column in
book 2.

if there is no match, then it should add those data not matched into
book1 at the last of A column.

here is my code:

Sub master()

Dim b1 As Workbook

Dim w1 As Worksheet

Dim rCell As Range
Dim LookRange As Range
Application.ScreenUpdating = False

MsgBox ("Select the Subset File location")

Set b1 = Workbooks.Open(Application.GetOpenFilename(, , "Open File
1"))
Set w1 = b1.Worksheets("suppliers")

Set LookRange = Sheets("suppliers").Range("A1",
Range("A65536").End(xlUp))

MsgBox LookRange.Address

For Each rCell In LookRange


' here it give script out of range error.!!!!???????

If WorksheetFunction.CountIf _
(Sheets("pros").Columns(1), rCell.Text) = 0 Then
rCell.Range("A2:C1").Copy _
Destination:=Sheets("pros").Range("A65536").End(xl Up).Offset(1, 0)

End If

Next rCell

Application.CutCopyMode = False

Application.ScreenUpdating = True

Sheets("pros").Range("A1:A65536").HorizontalAlignm ent = xlRight

Sheets("prols").Activate

End Sub


can anyone help in this..?

thanks,

kaza