View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Kaza Sriram Kaza Sriram is offline
external usenet poster
 
Posts: 6
Default compare two ranges in different workbooks and copy data to a new workbook

hi ,

i am new to the board and also new to VBA , i was wondering if someone
could help me in this following problem in VBA code:

here is the problem description:

I have two spreadsheets in different workbooks ( workbook 1: sheet 1
and workbook2: sheet1), here i need to compare column 5 in Book1 and
Column 5 for all cells, say X is the value we are looking for..

X occurs once in book1 and might occur more than once in book2..so if
a match occurs ( that is once the code checks that there is X occuring
in both books in columns 5) it should copy all rows in book 2 where X
occurs to a new workbook 3 in sheet 1 and also it shoud copy entire
row data where X occurs in book 1 sheet 1 . But this data from book 1
has to be copied at the end of row after the data from book 2 has been
copied.

if X occurs 4 times in book 2 , then 4 rows have to be copied in book
3 and then data from Book 1 where X occurs only once is copied 4 times
at the end of the data from book 2.

this process has to repeated for all cells in columns 5 in book1 and
column 5 in book2 .

i just started on the code and tried my best of programming skills
which is not that great i guess :((

i 'll be grateful if someone can help me on this..below is my code:


Sub Find_Matches()

Dim M, N As Range, x As variant, y As variant
Dim NewRange As Range

‘ to get the book1 location

MsgBox " Selec the Location of N File"

Application.Dialogs(xlDialogOpen).Show arg1:=""
ActiveWorkbook.Activate

Windows("N.xls").Activate

Sheets("sheetA").Select

Columns("E").Select

Set N = Columns("E")

‘ to get book 2 location

MsgBox "Select the Location of M File"

Application.Dialogs(xlDialogOpen).Show arg1:=""

ActiveWorkbook.Activate
Sheets("sheetB").Select
Application.ScreenUpdating = False
Columns("E").Select

Set M = Columns("E")

‘ this is where I am stuck bigtime.!!!!!!!!!!!

For Each x In M

For Each y In N

If cell = y Then y.Offset(0, 1) = y
Set NewRange = Union(Worksheets("sheetB").x.EntireRow,
Worksheets("SheetA").y.EntireRow)
Else
Set NewRange = Nothing

End If

Next y
Next x

‘ this opens the 3rd work bookbook

Windows("Copy.xls").Activate
Worksheets("Sheets1").Select
NewRange.Copy
ActiveSheet.Paste

Selection.PasteSpecial Paste:=xlValues

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub