match some fields & write new file

Hi everyone,
I have 2 sheets in a workbook.
Sheet1 has 14 fields and first 4 are unique
Sheet2 has 21 fields and first 4 are unique (say equal to sheet1)
Now, How to pick each row from sheet1 (4 fields) find their equals in sheet2
collect those equal rows and put in a new workbook and close with a new name.

Any help on this please (code or links).

This is the kind of thing. You'll want to amend it (unless you're happy to
wait for a couple of hours!) as it currently compares all empty cells too.
It also pastes to a sheet in the same workbook (sheet3) rather than a
workbook:

Sub PasteMatches()
Dim cell1 As Range
Dim cell2 As Range
For Each cell1 In Worksheets("Sheet1").Columns(1).Cells
For Each cell2 In Worksheets("Sheet2").Columns(1).Cells
If cell2.Value & cell2.Offset(0, 1).Value & cell2.Offset(0, 2).Value
& cell2.Offset(0, 3).Value = cell1.Value & cell1.Offset(0, 1).Value &
cell1.Offset(0, 2).Value & cell1.Offset(0, 3).Value Then
cell2.EntireRow.Copy
Worksheets("Sheet3").Activate
Range("A1").CurrentRegion.Select
Selection.Offset(Selection.Rows.Count).Resize(1, 1).Select
ActiveSheet.Paste
End If
Next cell2
Next cell1
End Sub

"Eddy Stan" wrote:

> Hi everyone,
> I have 2 sheets in a workbook.
> Sheet1 has 14 fields and first 4 are unique
> Sheet2 has 21 fields and first 4 are unique (say equal to sheet1)
> Now, How to pick each row from sheet1 (4 fields) find their equals in sheet2
> collect those equal rows and put in a new workbook and close with a new name.
>
> Any help on this please (code or links).
>
>

boss it didn't work. each time it gives different error.
and it did write even one matching in sheet3.
Can you try please.
Further the code runs more up to 4 min for 5 rows in sheet1 and 1000 rows in
sheet2

"Martin" wrote:

> This is the kind of thing. You'll want to amend it (unless you're happy to
> wait for a couple of hours!) as it currently compares all empty cells too.
> It also pastes to a sheet in the same workbook (sheet3) rather than a
> workbook:
>
> Sub PasteMatches()
> Dim cell1 As Range
> Dim cell2 As Range
> For Each cell1 In Worksheets("Sheet1").Columns(1).Cells
> For Each cell2 In Worksheets("Sheet2").Columns(1).Cells
> If cell2.Value & cell2.Offset(0, 1).Value & cell2.Offset(0, 2).Value
> & cell2.Offset(0, 3).Value = cell1.Value & cell1.Offset(0, 1).Value &
> cell1.Offset(0, 2).Value & cell1.Offset(0, 3).Value Then
> cell2.EntireRow.Copy
> Worksheets("Sheet3").Activate
> Range("A1").CurrentRegion.Select
> Selection.Offset(Selection.Rows.Count).Resize(1, 1).Select
> ActiveSheet.Paste
> End If
> Next cell2
> Next cell1
> End Sub
>
> "Eddy Stan" wrote:
>
> > Hi everyone,
> > I have 2 sheets in a workbook.
> > Sheet1 has 14 fields and first 4 are unique
> > Sheet2 has 21 fields and first 4 are unique (say equal to sheet1)
> > Now, How to pick each row from sheet1 (4 fields) find their equals in sheet2
> > collect those equal rows and put in a new workbook and close with a new name.
> >
> > Any help on this please (code or links).
> >
> >

Hi Martin,
your code is not giving error or not giving answer to my problem.
Can you try with your own example and send me your sample excel sheet to
[email protected]

Thanks for your try...

"Martin" wrote:

> This is the kind of thing. You'll want to amend it (unless you're happy to
> wait for a couple of hours!) as it currently compares all empty cells too.
> It also pastes to a sheet in the same workbook (sheet3) rather than a
> workbook:
>
> Sub PasteMatches()
> Dim cell1 As Range
> Dim cell2 As Range
> For Each cell1 In Worksheets("Sheet1").Columns(1).Cells
> For Each cell2 In Worksheets("Sheet2").Columns(1).Cells
> If cell2.Value & cell2.Offset(0, 1).Value & cell2.Offset(0, 2).Value
> & cell2.Offset(0, 3).Value = cell1.Value & cell1.Offset(0, 1).Value &
> cell1.Offset(0, 2).Value & cell1.Offset(0, 3).Value Then
> cell2.EntireRow.Copy
> Worksheets("Sheet3").Activate
> Range("A1").CurrentRegion.Select
> Selection.Offset(Selection.Rows.Count).Resize(1, 1).Select
> ActiveSheet.Paste
> End If
> Next cell2
> Next cell1
> End Sub
>
> "Eddy Stan" wrote:
>
> > Hi everyone,
> > I have 2 sheets in a workbook.
> > Sheet1 has 14 fields and first 4 are unique
> > Sheet2 has 21 fields and first 4 are unique (say equal to sheet1)
> > Now, How to pick each row from sheet1 (4 fields) find their equals in sheet2
> > collect those equal rows and put in a new workbook and close with a new name.
> >
> > Any help on this please (code or links).
> >
> >

Hello - somebody talk to me, I am desperate for excel code.

"Eddy Stan" wrote:

> Hi Martin,
> your code is not giving error or not giving answer to my problem.
> Can you try with your own example and send me your sample excel sheet to
> [email protected]
>
> Thanks for your try...
>
> "Martin" wrote:
>
> > This is the kind of thing. You'll want to amend it (unless you're happy to
> > wait for a couple of hours!) as it currently compares all empty cells too.
> > It also pastes to a sheet in the same workbook (sheet3) rather than a
> > workbook:
> >
> > Sub PasteMatches()
> > Dim cell1 As Range
> > Dim cell2 As Range
> > For Each cell1 In Worksheets("Sheet1").Columns(1).Cells
> > For Each cell2 In Worksheets("Sheet2").Columns(1).Cells
> > If cell2.Value & cell2.Offset(0, 1).Value & cell2.Offset(0, 2).Value
> > & cell2.Offset(0, 3).Value = cell1.Value & cell1.Offset(0, 1).Value &
> > cell1.Offset(0, 2).Value & cell1.Offset(0, 3).Value Then
> > cell2.EntireRow.Copy
> > Worksheets("Sheet3").Activate
> > Range("A1").CurrentRegion.Select
> > Selection.Offset(Selection.Rows.Count).Resize(1, 1).Select
> > ActiveSheet.Paste
> > End If
> > Next cell2
> > Next cell1
> > End Sub
> >
> > "Eddy Stan" wrote:
> >
> > > Hi everyone,
> > > I have 2 sheets in a workbook.
> > > Sheet1 has 14 fields and first 4 are unique
> > > Sheet2 has 21 fields and first 4 are unique (say equal to sheet1)
> > > Now, How to pick each row from sheet1 (4 fields) find their equals in sheet2
> > > collect those equal rows and put in a new workbook and close with a new name.
> > >
> > > Any help on this please (code or links).
> > >
> > >

Eddy,

I have just emailed you a workbook l am developing as ad Excel Add-In
that will do what you want. However the 2 lists will need to be copied
side by side to another sheet.

Regards

Michael beckinsale