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

Kaza,

Try the code below. Copy it in its entirety, and paste into a blank
codemodule. It was written on the assumption that both sheets are named
Sheet1: your explanation and your sample code had conflicting sheet names,
so you will need to fix that. Also, I wasn't sure how many cells around the
"X"cell in Book 1 you wanted to copy: I assumed the cell with X and the
three cells to the right: you can change the .Resize to match reality.

HTH,
Bernie
MS Excel MVP

Option Explicit
Dim d As Range ' All the cells found with what you want

Sub Find_Matches()

Dim rngM As Range
Dim rngN As Range
Dim cellX As Range
Dim cellY As Range
Dim Wbk1 As Workbook
Dim Wbk2 As Workbook
Dim Wbk3 As Workbook

' Get Workbook1
Set Wbk1 = Workbooks.Open(Application.GetOpenFilename(, , "Open File 1"))
With Wbk1.Worksheets("Sheet1")
Set rngN = Intersect(.Columns("E"), .UsedRange)
End With

' Get Workbook1
Set Wbk2 = Workbooks.Open(Application.GetOpenFilename(, , "Open File 2"))
With Wbk2.Worksheets("Sheet1")
Set rngM = Intersect(.Columns("E"), .UsedRange)
End With

Set Wbk3 = Workbooks.Add
Wbk3.SaveAs "Combined.xls"

For Each cellX In rngM
FindValues cellX, rngN
If Not d Is Nothing Then
With Wbk3.Worksheets(1)
d.EntireRow.Copy
.Range("A65536").End(xlUp)(2).PasteSpecial xlValues
cellX.Resize(1, 4).Copy
.Range(.Range("A65536").End(xlUp).End(xlToRight)(1 , 2), _
.Range("A65536").End(xlUp).End(xlToRight)(1, 2) _
.End(xlUp)(2)).PasteSpecial xlValues
End With
End If
Next cellX

End Sub
Sub FindValues(Range1 As Range, Range2 As Range)
Dim c As Range ' The cell found with what you want
Dim myFindString As String
Dim firstAddress As String

Set d = Nothing

myFindString = Range1.Value
With Range2

Set c = .Find(myFindString, LookIn:=xlValues, lookAt:=xlWhole)

If Not c Is Nothing Then
Set d = c
firstAddress = c.Address
End
End If

Set c = .FindNext(c)
If Not c Is Nothing And c.Address < firstAddress Then
Do
Set d = Union(d, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With

End Sub

"Kaza Sriram" wrote in message
om...
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

hi Bernie,

the code doesn't do anything..the combined.xls remains blank...i dont
know why is doing so, i am trying to debug..if nothing works....u know
what i'll make a two sample spreadsheets and send them to u ..so that
u can see better abt the working of code...
pls see if u can do anything...so u have anyemail where i can send the
spreadsheets..??

thanks a tonn for all help..!!:))

regards,

kaza





"Bernie Deitrick" <deitbe @ consumer dot org wrote in message ...
Kaza,

Try the code below. Copy it in its entirety, and paste into a blank
codemodule. It was written on the assumption that both sheets are named
Sheet1: your explanation and your sample code had conflicting sheet names,
so you will need to fix that. Also, I wasn't sure how many cells around the
"X"cell in Book 1 you wanted to copy: I assumed the cell with X and the
three cells to the right: you can change the .Resize to match reality.

HTH,
Bernie
MS Excel MVP

Option Explicit
Dim d As Range ' All the cells found with what you want

Sub Find_Matches()

Dim rngM As Range
Dim rngN As Range
Dim cellX As Range
Dim cellY As Range
Dim Wbk1 As Workbook
Dim Wbk2 As Workbook
Dim Wbk3 As Workbook

' Get Workbook1
Set Wbk1 = Workbooks.Open(Application.GetOpenFilename(, , "Open File 1"))
With Wbk1.Worksheets("Sheet1")
Set rngN = Intersect(.Columns("E"), .UsedRange)
End With

' Get Workbook1
Set Wbk2 = Workbooks.Open(Application.GetOpenFilename(, , "Open File 2"))
With Wbk2.Worksheets("Sheet1")
Set rngM = Intersect(.Columns("E"), .UsedRange)
End With

Set Wbk3 = Workbooks.Add
Wbk3.SaveAs "Combined.xls"

For Each cellX In rngM
FindValues cellX, rngN
If Not d Is Nothing Then
With Wbk3.Worksheets(1)
d.EntireRow.Copy
.Range("A65536").End(xlUp)(2).PasteSpecial xlValues
cellX.Resize(1, 4).Copy
.Range(.Range("A65536").End(xlUp).End(xlToRight)(1 , 2), _
.Range("A65536").End(xlUp).End(xlToRight)(1, 2) _
.End(xlUp)(2)).PasteSpecial xlValues
End With
End If
Next cellX

End Sub
Sub FindValues(Range1 As Range, Range2 As Range)
Dim c As Range ' The cell found with what you want
Dim myFindString As String
Dim firstAddress As String

Set d = Nothing

myFindString = Range1.Value
With Range2

Set c = .Find(myFindString, LookIn:=xlValues, lookAt:=xlWhole)

If Not c Is Nothing Then
Set d = c
firstAddress = c.Address
End
End If

Set c = .FindNext(c)
If Not c Is Nothing And c.Address < firstAddress Then
Do
Set d = Union(d, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With

End Sub

"Kaza Sriram" wrote in message
om...
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

Kaza,

Fix the email address here by taking out spaces and replacing the dot with a
..

HTH,
Bernie
MS Excel MVP

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

the code doesn't do anything..the combined.xls remains blank...i dont
know why is doing so, i am trying to debug..if nothing works....u know
what i'll make a two sample spreadsheets and send them to u ..so that
u can see better abt the working of code...
pls see if u can do anything...so u have anyemail where i can send the
spreadsheets..??

thanks a tonn for all help..!!:))

regards,

kaza





"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
Kaza,

Try the code below. Copy it in its entirety, and paste into a blank
codemodule. It was written on the assumption that both sheets are named
Sheet1: your explanation and your sample code had conflicting sheet
names,
so you will need to fix that. Also, I wasn't sure how many cells around
the
"X"cell in Book 1 you wanted to copy: I assumed the cell with X and the
three cells to the right: you can change the .Resize to match reality.

HTH,
Bernie
MS Excel MVP

Option Explicit
Dim d As Range ' All the cells found with what you want

Sub Find_Matches()

Dim rngM As Range
Dim rngN As Range
Dim cellX As Range
Dim cellY As Range
Dim Wbk1 As Workbook
Dim Wbk2 As Workbook
Dim Wbk3 As Workbook

' Get Workbook1
Set Wbk1 = Workbooks.Open(Application.GetOpenFilename(, , "Open File
1"))
With Wbk1.Worksheets("Sheet1")
Set rngN = Intersect(.Columns("E"), .UsedRange)
End With

' Get Workbook1
Set Wbk2 = Workbooks.Open(Application.GetOpenFilename(, , "Open File
2"))
With Wbk2.Worksheets("Sheet1")
Set rngM = Intersect(.Columns("E"), .UsedRange)
End With

Set Wbk3 = Workbooks.Add
Wbk3.SaveAs "Combined.xls"

For Each cellX In rngM
FindValues cellX, rngN
If Not d Is Nothing Then
With Wbk3.Worksheets(1)
d.EntireRow.Copy
.Range("A65536").End(xlUp)(2).PasteSpecial xlValues
cellX.Resize(1, 4).Copy
.Range(.Range("A65536").End(xlUp).End(xlToRight)(1 , 2), _
.Range("A65536").End(xlUp).End(xlToRight)(1, 2) _
.End(xlUp)(2)).PasteSpecial xlValues
End With
End If
Next cellX

End Sub
Sub FindValues(Range1 As Range, Range2 As Range)
Dim c As Range ' The cell found with what you want
Dim myFindString As String
Dim firstAddress As String

Set d = Nothing

myFindString = Range1.Value
With Range2

Set c = .Find(myFindString, LookIn:=xlValues, lookAt:=xlWhole)

If Not c Is Nothing Then
Set d = c
firstAddress = c.Address
End
End If

Set c = .FindNext(c)
If Not c Is Nothing And c.Address < firstAddress Then
Do
Set d = Union(d, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With

End Sub

"Kaza Sriram" wrote in message
om...
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

Bernie,

i just sent u an email...did u receive it..?? otherwise send me an
email at the id:

thanks,

kaza


"Bernie Deitrick" <deitbe @ consumer dot org wrote in message ...
Kaza,

Fix the email address here by taking out spaces and replacing the dot with a
.

HTH,
Bernie
MS Excel MVP

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

the code doesn't do anything..the combined.xls remains blank...i dont
know why is doing so, i am trying to debug..if nothing works....u know
what i'll make a two sample spreadsheets and send them to u ..so that
u can see better abt the working of code...
pls see if u can do anything...so u have anyemail where i can send the
spreadsheets..??

thanks a tonn for all help..!!:))

regards,

kaza





"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
Kaza,

Try the code below. Copy it in its entirety, and paste into a blank
codemodule. It was written on the assumption that both sheets are named
Sheet1: your explanation and your sample code had conflicting sheet
names,
so you will need to fix that. Also, I wasn't sure how many cells around
the
"X"cell in Book 1 you wanted to copy: I assumed the cell with X and the
three cells to the right: you can change the .Resize to match reality.

HTH,
Bernie
MS Excel MVP

Option Explicit
Dim d As Range ' All the cells found with what you want

Sub Find_Matches()

Dim rngM As Range
Dim rngN As Range
Dim cellX As Range
Dim cellY As Range
Dim Wbk1 As Workbook
Dim Wbk2 As Workbook
Dim Wbk3 As Workbook

' Get Workbook1
Set Wbk1 = Workbooks.Open(Application.GetOpenFilename(, , "Open File
1"))
With Wbk1.Worksheets("Sheet1")
Set rngN = Intersect(.Columns("E"), .UsedRange)
End With

' Get Workbook1
Set Wbk2 = Workbooks.Open(Application.GetOpenFilename(, , "Open File
2"))
With Wbk2.Worksheets("Sheet1")
Set rngM = Intersect(.Columns("E"), .UsedRange)
End With

Set Wbk3 = Workbooks.Add
Wbk3.SaveAs "Combined.xls"

For Each cellX In rngM
FindValues cellX, rngN
If Not d Is Nothing Then
With Wbk3.Worksheets(1)
d.EntireRow.Copy
.Range("A65536").End(xlUp)(2).PasteSpecial xlValues
cellX.Resize(1, 4).Copy
.Range(.Range("A65536").End(xlUp).End(xlToRight)(1 , 2), _
.Range("A65536").End(xlUp).End(xlToRight)(1, 2) _
.End(xlUp)(2)).PasteSpecial xlValues
End With
End If
Next cellX

End Sub
Sub FindValues(Range1 As Range, Range2 As Range)
Dim c As Range ' The cell found with what you want
Dim myFindString As String
Dim firstAddress As String

Set d = Nothing

myFindString = Range1.Value
With Range2

Set c = .Find(myFindString, LookIn:=xlValues, lookAt:=xlWhole)

If Not c Is Nothing Then
Set d = c
firstAddress = c.Address
End
End If

Set c = .FindNext(c)
If Not c Is Nothing And c.Address < firstAddress Then
Do
Set d = Union(d, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With

End Sub

"Kaza Sriram" wrote in message
om...
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

Kaza,

No, I didn't get it, so I will send you one now...

HTH,
Bernie
MS Excel MVP

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

i just sent u an email...did u receive it..?? otherwise send me an
email at the id:

thanks,

kaza


"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
Kaza,

Fix the email address here by taking out spaces and replacing the dot
with a
.

HTH,
Bernie
MS Excel MVP

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

the code doesn't do anything..the combined.xls remains blank...i dont
know why is doing so, i am trying to debug..if nothing works....u know
what i'll make a two sample spreadsheets and send them to u ..so that
u can see better abt the working of code...
pls see if u can do anything...so u have anyemail where i can send the
spreadsheets..??

thanks a tonn for all help..!!:))

regards,

kaza





"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
Kaza,

Try the code below. Copy it in its entirety, and paste into a blank
codemodule. It was written on the assumption that both sheets are
named
Sheet1: your explanation and your sample code had conflicting sheet
names,
so you will need to fix that. Also, I wasn't sure how many cells
around
the
"X"cell in Book 1 you wanted to copy: I assumed the cell with X and
the
three cells to the right: you can change the .Resize to match
reality.

HTH,
Bernie
MS Excel MVP

Option Explicit
Dim d As Range ' All the cells found with what you want

Sub Find_Matches()

Dim rngM As Range
Dim rngN As Range
Dim cellX As Range
Dim cellY As Range
Dim Wbk1 As Workbook
Dim Wbk2 As Workbook
Dim Wbk3 As Workbook

' Get Workbook1
Set Wbk1 = Workbooks.Open(Application.GetOpenFilename(, , "Open File
1"))
With Wbk1.Worksheets("Sheet1")
Set rngN = Intersect(.Columns("E"), .UsedRange)
End With

' Get Workbook1
Set Wbk2 = Workbooks.Open(Application.GetOpenFilename(, , "Open File
2"))
With Wbk2.Worksheets("Sheet1")
Set rngM = Intersect(.Columns("E"), .UsedRange)
End With

Set Wbk3 = Workbooks.Add
Wbk3.SaveAs "Combined.xls"

For Each cellX In rngM
FindValues cellX, rngN
If Not d Is Nothing Then
With Wbk3.Worksheets(1)
d.EntireRow.Copy
.Range("A65536").End(xlUp)(2).PasteSpecial xlValues
cellX.Resize(1, 4).Copy
.Range(.Range("A65536").End(xlUp).End(xlToRight)(1 , 2), _
.Range("A65536").End(xlUp).End(xlToRight)(1, 2) _
.End(xlUp)(2)).PasteSpecial xlValues
End With
End If
Next cellX

End Sub
Sub FindValues(Range1 As Range, Range2 As Range)
Dim c As Range ' The cell found with what you want
Dim myFindString As String
Dim firstAddress As String

Set d = Nothing

myFindString = Range1.Value
With Range2

Set c = .Find(myFindString, LookIn:=xlValues, lookAt:=xlWhole)

If Not c Is Nothing Then
Set d = c
firstAddress = c.Address
End
End If

Set c = .FindNext(c)
If Not c Is Nothing And c.Address < firstAddress Then
Do
Set d = Union(d, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With

End Sub

"Kaza Sriram" wrote in message
om...
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

hi Bernie,

hi Bernie,

the macro doesnt nor match these:

project no 405208 and system no 405208-WA..there r lots of rows like
this and should match..

also the format is jumbled up..actually book 1 has around 65 rows and
book 2 has around 25 rows

the data has to be pasted in book 3 like this:

first data from book 2 having 25 rows and then data from book 1 having
65 rows

please can u help me out in this..

thanks a lottt,

kaza


"Bernie Deitrick" <deitbe @ consumer dot org wrote in message ...
Kaza,

No, I didn't get it, so I will send you one now...

HTH,
Bernie
MS Excel MVP

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

i just sent u an email...did u receive it..?? otherwise send me an
email at the id:

thanks,

kaza


"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
Kaza,

Fix the email address here by taking out spaces and replacing the dot
with a
.

HTH,
Bernie
MS Excel MVP

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

the code doesn't do anything..the combined.xls remains blank...i dont
know why is doing so, i am trying to debug..if nothing works....u know
what i'll make a two sample spreadsheets and send them to u ..so that
u can see better abt the working of code...
pls see if u can do anything...so u have anyemail where i can send the
spreadsheets..??

thanks a tonn for all help..!!:))

regards,

kaza





"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
Kaza,

Try the code below. Copy it in its entirety, and paste into a blank
codemodule. It was written on the assumption that both sheets are
named
Sheet1: your explanation and your sample code had conflicting sheet
names,
so you will need to fix that. Also, I wasn't sure how many cells
around
the
"X"cell in Book 1 you wanted to copy: I assumed the cell with X and
the
three cells to the right: you can change the .Resize to match
reality.

HTH,
Bernie
MS Excel MVP

Option Explicit
Dim d As Range ' All the cells found with what you want

Sub Find_Matches()

Dim rngM As Range
Dim rngN As Range
Dim cellX As Range
Dim cellY As Range
Dim Wbk1 As Workbook
Dim Wbk2 As Workbook
Dim Wbk3 As Workbook

' Get Workbook1
Set Wbk1 = Workbooks.Open(Application.GetOpenFilename(, , "Open File
1"))
With Wbk1.Worksheets("Sheet1")
Set rngN = Intersect(.Columns("E"), .UsedRange)
End With

' Get Workbook1
Set Wbk2 = Workbooks.Open(Application.GetOpenFilename(, , "Open File
2"))
With Wbk2.Worksheets("Sheet1")
Set rngM = Intersect(.Columns("E"), .UsedRange)
End With

Set Wbk3 = Workbooks.Add
Wbk3.SaveAs "Combined.xls"

For Each cellX In rngM
FindValues cellX, rngN
If Not d Is Nothing Then
With Wbk3.Worksheets(1)
d.EntireRow.Copy
.Range("A65536").End(xlUp)(2).PasteSpecial xlValues
cellX.Resize(1, 4).Copy
.Range(.Range("A65536").End(xlUp).End(xlToRight)(1 , 2), _
.Range("A65536").End(xlUp).End(xlToRight)(1, 2) _
.End(xlUp)(2)).PasteSpecial xlValues
End With
End If
Next cellX

End Sub
Sub FindValues(Range1 As Range, Range2 As Range)
Dim c As Range ' The cell found with what you want
Dim myFindString As String
Dim firstAddress As String

Set d = Nothing

myFindString = Range1.Value
With Range2

Set c = .Find(myFindString, LookIn:=xlValues, lookAt:=xlWhole)

If Not c Is Nothing Then
Set d = c
firstAddress = c.Address
End
End If

Set c = .FindNext(c)
If Not c Is Nothing And c.Address < firstAddress Then
Do
Set d = Union(d, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With

End Sub

"Kaza Sriram" wrote in message
om...
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

Kaza,

You are probably opening the files in reverse order.

HTH,
Bernie
MS Excel MVP

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

hi Bernie,

the macro doesnt nor match these:

project no 405208 and system no 405208-WA..there r lots of rows like
this and should match..

also the format is jumbled up..actually book 1 has around 65 rows and
book 2 has around 25 rows

the data has to be pasted in book 3 like this:

first data from book 2 having 25 rows and then data from book 1 having
65 rows

please can u help me out in this..

thanks a lottt,

kaza


"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
Kaza,

No, I didn't get it, so I will send you one now...

HTH,
Bernie
MS Excel MVP

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

i just sent u an email...did u receive it..?? otherwise send me an
email at the id:

thanks,

kaza


"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
Kaza,

Fix the email address here by taking out spaces and replacing the
dot
with a
.

HTH,
Bernie
MS Excel MVP

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

the code doesn't do anything..the combined.xls remains blank...i
dont
know why is doing so, i am trying to debug..if nothing works....u
know
what i'll make a two sample spreadsheets and send them to u ..so
that
u can see better abt the working of code...
pls see if u can do anything...so u have anyemail where i can send
the
spreadsheets..??

thanks a tonn for all help..!!:))

regards,

kaza





"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
Kaza,

Try the code below. Copy it in its entirety, and paste into a
blank
codemodule. It was written on the assumption that both sheets
are
named
Sheet1: your explanation and your sample code had conflicting
sheet
names,
so you will need to fix that. Also, I wasn't sure how many
cells
around
the
"X"cell in Book 1 you wanted to copy: I assumed the cell with X
and
the
three cells to the right: you can change the .Resize to match
reality.

HTH,
Bernie
MS Excel MVP

Option Explicit
Dim d As Range ' All the cells found with what you want

Sub Find_Matches()

Dim rngM As Range
Dim rngN As Range
Dim cellX As Range
Dim cellY As Range
Dim Wbk1 As Workbook
Dim Wbk2 As Workbook
Dim Wbk3 As Workbook

' Get Workbook1
Set Wbk1 = Workbooks.Open(Application.GetOpenFilename(, , "Open
File
1"))
With Wbk1.Worksheets("Sheet1")
Set rngN = Intersect(.Columns("E"), .UsedRange)
End With

' Get Workbook1
Set Wbk2 = Workbooks.Open(Application.GetOpenFilename(, , "Open
File
2"))
With Wbk2.Worksheets("Sheet1")
Set rngM = Intersect(.Columns("E"), .UsedRange)
End With

Set Wbk3 = Workbooks.Add
Wbk3.SaveAs "Combined.xls"

For Each cellX In rngM
FindValues cellX, rngN
If Not d Is Nothing Then
With Wbk3.Worksheets(1)
d.EntireRow.Copy
.Range("A65536").End(xlUp)(2).PasteSpecial xlValues
cellX.Resize(1, 4).Copy
.Range(.Range("A65536").End(xlUp).End(xlToRight)(1 , 2),
_
.Range("A65536").End(xlUp).End(xlToRight)(1, 2) _
.End(xlUp)(2)).PasteSpecial xlValues
End With
End If
Next cellX

End Sub
Sub FindValues(Range1 As Range, Range2 As Range)
Dim c As Range ' The cell found with what you want
Dim myFindString As String
Dim firstAddress As String

Set d = Nothing

myFindString = Range1.Value
With Range2

Set c = .Find(myFindString, LookIn:=xlValues,
lookAt:=xlWhole)

If Not c Is Nothing Then
Set d = c
firstAddress = c.Address
End
End If

Set c = .FindNext(c)
If Not c Is Nothing And c.Address < firstAddress Then
Do
Set d = Union(d, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With

End Sub

"Kaza Sriram" wrote in message
om...
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