I have received plenty of help from here with several macro's
attempting to solve my problem. But the problem was never resolved.
Most of it is my fault. After reviewing the macro's and my original
description of my problem, I am trying to make another post that might
actually solve my problem. The last attempt worked ok except for the
fact I left part of the end results of the previous macro on my sheet
1. (read below) After the sort, it was reading the data at the bottom
of sheet 1:col B and placing it on Sheet 4. And that data was used to
come up with a solution. When I deleted the data:Col B from the other
Macro, there was no Col B data on Sheet 4 when the final macro(below)
was ran. After chatting with one of the MVP's. Here is what I need:

VLookup will not work because it will only return 1 item. I have
multiple items for 1 match in most cases. Example: 1 employee might
have 4 id's. I have a file if someone wants it.

For each item in col A of sheet2 I want to look for a match in col A
of sheet 1. If there is a match I want(all)="that cell"="that item" of
the row:col B of Sheet2 copied to Col B sheet 4. Etc I then want?

This is the tricky part:
For each item in col A of sheet2 I want to look for a match in col A
of sheet 1. If there is a match I want(all) of the row:col C to col P
of Sheet1 copied to sheet 3.

In other words:

I want info from sheet 1 cells in Col A that match cells A:B in Sheet
2_____ to be put in sheet 4.

I want info from sheet 1 cells in Col C to Col P that match cells A:
in Sheet 4_____ to be put in sheet 4 where? in col C to col P.

Here is the last piece of code but I know everyone writes differently:

Option Explicit
Sub MakeDestinationSheet()
Dim n
Dim c
Dim lr, slr, ifshtlr As Long
Dim srcsht, ifsht, destsht As Worksheet
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Set srcsht = Sheets("sheet1")
Set ifsht = Sheets("sheet2")
ifshtlr = ifsht.Cells(Rows.Count, 1).End(xlUp).Row

Set destsht = Sheets("Sheet4")
destsht.Select

With destsht
lr = .Cells(Rows.Count, 1).End(xlUp).Row
..Rows(2).Resize(lr).Delete

For Each n In ifsht.Range("a2:a" & ifshtlr)
Set c = destsht.Columns(1).Find(n, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If c Is Nothing Then
slr = srcsht.Cells(Rows.Count, 1).End(xlUp).Row
With srcsht.Range("A4:p" & slr)
.AutoFilter Field:=1, Criteria1:=n
lr = destsht.Cells(Rows.Count, 1).End(xlUp).Row + 1
slr = srcsht.Cells(Rows.Count, 1).End(xlUp).Row
srcsht.Range("a5:p" & slr).Copy destsht.Cells(lr, 1)
..AutoFilter
End With

End If
Next n
.Range(Cells(2, "c"), Cells(lr + 1, "p")).SpecialCells
(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
.Range(Cells(2, "j"), Cells(lr + 1, "k")).NumberFormat = "mm/dd/yyyy"
.Range(Cells(2, "c"), Cells(lr + 1, "p")).Value = _
.Range(Cells(2, "c"), Cells(lr + 1, "p")).Value
.Columns("b").SpecialCells(xlCellTypeBlanks).Entir eRow.Delete
.Columns("L").Style = "Comma"
.Columns.AutoFit

End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Warm regards,
Ty

Can you post samples of the data you are starting with and the results you
are actaull looking for. Your description isn't any better the your
prevvious postinggs and without actual data I don't think you will get the
results you are looking for.

My previous code worked except you where unhappy with the column b data that
was put in the destination sheet. Sheet 1 column B didn't have the data you
were looking for. You wanted my to put the sheet 2 column B data into column
B in the destination sheet. But column B in sheet 2 had various didfferent
results.

People should read your previous posting before trying to solve this problem

http://www.microsoft.com/office/comm...b-4920aef45c1b

This is the results I think will work from my previous posting

Sub Duplicates()
'
' NOTE: The macro assumes there is a header in the both worksheets
' The macro starts at row 2 and sort data automatically
'
ScreenUpdating = False

'copy sheet 1 to sheet 3
With Sheets("Sheet3")
Sheets("Sheet1").Cells.Copy _
Destination:=.Cells

'find last row
LastRowA = .Range("A" & Rows.Count).End(xlUp).Row
LastRowB = .Range("B" & Rows.Count).End(xlUp).Row

If LastRowA LastRowB Then
LastRow = LastRowA
Else
LastRow = LastRowB
End If

NewRow = LastRow + 1

With Sheets("Sheet2")
'find last row
LastRow2 = .Range("A" & Rows.Count).End(xlUp).Row
End With

'copy sheet 2 to end of sheet 3, only columns A & B
Sheets("Sheet2").Range("A1:B" & LastRow2).Copy _
Destination:=.Range("A" & NewRow)


'Sort Data
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Rows("1:" & LastRow).Sort _
header:=xlYes, _
Key1:=.Range("A1"), _
order1:=xlAscending


'Mark row which aren't duplicates so they can be removed

RowCount = 3
Do While .Range("A" & RowCount) < ""
'check if ID matches either previous or next row
If .Range("A" & RowCount) < .Range("A" & (RowCount - 1)) And _
.Range("A" & RowCount) < .Range("A" & (RowCount + 1)) Then

.Range("IV" & RowCount) = "X"

End If
RowCount = RowCount + 1
Loop

'put anything in cell IV1 so filter works properly
.Range("IV1") = "Anything"
'filter on x's
.Columns("IV:IV").AutoFilter
.Columns("IV:IV").AutoFilter Field:=1, Criteria1:="X"

Set VisibleRows = .Rows("2:" & LastRow) _
.SpecialCells(xlCellTypeVisible)
'delete rows with X's
VisibleRows.Delete
'turn off autfilter
.Columns("IV:IV").AutoFilter
'clear IV1
.Range("IV1").Clear

End With

ScreenUpdating = True

End Sub



"Ty" wrote:

I have received plenty of help from here with several macro's
attempting to solve my problem. But the problem was never resolved.
Most of it is my fault. After reviewing the macro's and my original
description of my problem, I am trying to make another post that might
actually solve my problem. The last attempt worked ok except for the
fact I left part of the end results of the previous macro on my sheet
1. (read below) After the sort, it was reading the data at the bottom
of sheet 1:col B and placing it on Sheet 4. And that data was used to
come up with a solution. When I deleted the data:Col B from the other
Macro, there was no Col B data on Sheet 4 when the final macro(below)
was ran. After chatting with one of the MVP's. Here is what I need:

VLookup will not work because it will only return 1 item. I have
multiple items for 1 match in most cases. Example: 1 employee might
have 4 id's. I have a file if someone wants it.

For each item in col A of sheet2 I want to look for a match in col A
of sheet 1. If there is a match I want(all)="that cell"="that item" of
the row:col B of Sheet2 copied to Col B sheet 4. Etc I then want?

This is the tricky part:
For each item in col A of sheet2 I want to look for a match in col A
of sheet 1. If there is a match I want(all) of the row:col C to col P
of Sheet1 copied to sheet 3.

In other words:

I want info from sheet 1 cells in Col A that match cells A:B in Sheet
2_____ to be put in sheet 4.

I want info from sheet 1 cells in Col C to Col P that match cells A:
in Sheet 4_____ to be put in sheet 4 where? in col C to col P.

Here is the last piece of code but I know everyone writes differently:

Option Explicit
Sub MakeDestinationSheet()
Dim n
Dim c
Dim lr, slr, ifshtlr As Long
Dim srcsht, ifsht, destsht As Worksheet
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Set srcsht = Sheets("sheet1")
Set ifsht = Sheets("sheet2")
ifshtlr = ifsht.Cells(Rows.Count, 1).End(xlUp).Row

Set destsht = Sheets("Sheet4")
destsht.Select

With destsht
lr = .Cells(Rows.Count, 1).End(xlUp).Row
..Rows(2).Resize(lr).Delete

For Each n In ifsht.Range("a2:a" & ifshtlr)
Set c = destsht.Columns(1).Find(n, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If c Is Nothing Then
slr = srcsht.Cells(Rows.Count, 1).End(xlUp).Row
With srcsht.Range("A4:p" & slr)
.AutoFilter Field:=1, Criteria1:=n
lr = destsht.Cells(Rows.Count, 1).End(xlUp).Row + 1
slr = srcsht.Cells(Rows.Count, 1).End(xlUp).Row
srcsht.Range("a5:p" & slr).Copy destsht.Cells(lr, 1)
..AutoFilter
End With

End If
Next n
.Range(Cells(2, "c"), Cells(lr + 1, "p")).SpecialCells
(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
.Range(Cells(2, "j"), Cells(lr + 1, "k")).NumberFormat = "mm/dd/yyyy"
.Range(Cells(2, "c"), Cells(lr + 1, "p")).Value = _
.Range(Cells(2, "c"), Cells(lr + 1, "p")).Value
.Columns("b").SpecialCells(xlCellTypeBlanks).Entir eRow.Delete
.Columns("L").Style = "Comma"
.Columns.AutoFit

End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Warm regards,
Ty

On Aug 20, 4:25*am, Joel wrote:
Can you post samples of the data you are starting with and the results you
are actaull looking for. *Your description isn't any better the your
prevvious postinggs and without actual data I don't think you will get the
results you are looking for.

My previous code worked except you where unhappy with the column b data that
was put in the destination sheet. *Sheet 1 column B didn't have the data you
were looking for. *You wanted my to put the sheet 2 column B data into column
B in the destination sheet. *But column B in sheet 2 had various didfferent
results.

People should read your previous posting before trying to solve this problem

http://www.microsoft.com/office/comm....mspx?&query=T....

This is the results I think will work from my previous posting

Sub Duplicates()
* *'
* *' NOTE: The macro assumes there is a header in the both worksheets
* *' * * * The macro starts at row 2 and sort data automatically
* *'
* *ScreenUpdating = False

* *'copy sheet 1 to sheet 3
* *With Sheets("Sheet3")
* * * Sheets("Sheet1").Cells.Copy _
* * * * *Destination:=.Cells

* * * 'find last row
* * * LastRowA = .Range("A" & Rows.Count).End(xlUp).Row
* * * LastRowB = .Range("B" & Rows.Count).End(xlUp).Row

* * * If LastRowA LastRowB Then
* * * * *LastRow = LastRowA
* * * Else
* * * * *LastRow = LastRowB
* * * End If

* * * NewRow = LastRow + 1

* * * With Sheets("Sheet2")
* * * * *'find last row
* * * * *LastRow2 = .Range("A" & Rows.Count).End(xlUp).Row
* * * End With

* * * 'copy sheet 2 to end of sheet 3, only columns A & B
* * * Sheets("Sheet2").Range("A1:B" & LastRow2).Copy _
* * * * *Destination:=.Range("A" & NewRow)

* * * 'Sort Data
* * * LastRow = .Range("A" & Rows.Count).End(xlUp).Row
* * * .Rows("1:" & LastRow).Sort _
* * * * *header:=xlYes, _
* * * * *Key1:=.Range("A1"), _
* * * * *order1:=xlAscending

* * * 'Mark row which aren't duplicates so they can be removed

* * * RowCount = 3
* * * Do While .Range("A" & RowCount) < ""
* * * * *'check if ID matches either previous or next row
* * * * *If .Range("A" & RowCount) < .Range("A" & (RowCount - 1)) And _
* * * * * * .Range("A" & RowCount) < .Range("A" & (RowCount + 1)) Then

* * * * * * .Range("IV" & RowCount) = "X"

* * * * *End If
* * * * *RowCount = RowCount + 1
* * * Loop

* * * 'put anything in cell IV1 so filter works properly
* * * .Range("IV1") = "Anything"
* * * 'filter on x's
* * * .Columns("IV:IV").AutoFilter
* * * .Columns("IV:IV").AutoFilter Field:=1, Criteria1:="X"

* * * Set VisibleRows = .Rows("2:" & LastRow) _
* * * * *.SpecialCells(xlCellTypeVisible)
* * * 'delete rows with X's
* * * VisibleRows.Delete
* * * 'turn off autfilter
* * * .Columns("IV:IV").AutoFilter
* * * 'clear IV1
* * * .Range("IV1").Clear

* *End With

* *ScreenUpdating = True

End Sub



"Ty" wrote:
I have received plenty of help from here with several macro's
attempting to solve my problem. *But the problem was never resolved.
Most of it is my fault. *After reviewing the macro's and my original
description of my problem, I am trying to make another post that might
actually solve my problem. *The last attempt worked ok except for the
fact I left part of the end results of the previous macro on my sheet
1. *(read below) After the sort, it was reading the data at the bottom
of sheet 1:col B and placing it on Sheet 4. *And that data was used to
come up with a solution. *When I deleted the data:Col B from the other
Macro, there was no Col B data on Sheet 4 when the final macro(below)
was ran. *After chatting with one of the MVP's. *Here is what I need:

VLookup will not work because it will only return 1 item. *I have
multiple items for 1 match in most cases. *Example: *1 employee might
have 4 id's. *I have a file if someone wants it.

For each item in *col A of sheet2 I want to look for a match in col A
of sheet 1. If there is a match I want(all)="that cell"="that item" of
the row:col B of Sheet2 copied to Col B sheet 4. Etc I then want?

This is the tricky part:
For each item in *col A of sheet2 I want to look for a match in col A
of sheet 1. If there is a match I want(all) of the row:col C to col P
of Sheet1 copied to sheet 3.

In other words:

I want info from sheet 1 cells in Col A that match cells A:B in Sheet
2_____ to be put *in sheet 4.

I want info from sheet 1 cells in Col C to Col P that match cells A:
in Sheet 4_____ to be put *in sheet 4 where? in col C to col P.

Here is the last piece of code but I know everyone writes differently:

Option Explicit
Sub MakeDestinationSheet()
Dim n
Dim c
Dim lr, slr, ifshtlr As Long
Dim srcsht, ifsht, destsht As Worksheet
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Set srcsht = Sheets("sheet1")
Set ifsht = Sheets("sheet2")
ifshtlr = ifsht.Cells(Rows.Count, 1).End(xlUp).Row

Set destsht = Sheets("Sheet4")
destsht.Select

With destsht
lr = .Cells(Rows.Count, 1).End(xlUp).Row
..Rows(2).Resize(lr).Delete

For Each n In ifsht.Range("a2:a" & ifshtlr)
Set c = destsht.Columns(1).Find(n, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If c Is Nothing Then
slr = srcsht.Cells(Rows.Count, 1).End(xlUp).Row
With srcsht.Range("A4:p" & slr)
* * .AutoFilter Field:=1, Criteria1:=n
lr = destsht.Cells(Rows.Count, 1).End(xlUp).Row + 1
slr = srcsht.Cells(Rows.Count, 1).End(xlUp).Row
srcsht.Range("a5:p" & slr).Copy destsht.Cells(lr, 1)
..AutoFilter
End With

End If
Next n
*.Range(Cells(2, "c"), Cells(lr + 1, "p")).SpecialCells
(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
*.Range(Cells(2, "j"), Cells(lr + 1, "k")).NumberFormat = "mm/dd/yyyy"
*.Range(Cells(2, "c"), Cells(lr + 1, "p")).Value = _
*.Range(Cells(2, "c"), Cells(lr + 1, "p")).Value
*.Columns("b").SpecialCells(xlCellTypeBlanks).Enti reRow.Delete
*.Columns("L").Style = "Comma"
*.Columns.AutoFit

End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Warm regards,
Ty- Hide quoted text -

- Show quoted text -

First, thanks for the help. Here are some samples of the data. It's
difficult to place the data in .txt in here. I used the comma so you
can Import it into Excel using the "," as a delimiter. The ",," are
blank cells. In most lines down below, ",," is the ColB. Just fyi--
down below the fullname has a comma in 1 full cell on the original SS-
spreadsheet. The real columns on Sheet 1 go all the way to Col P and
sometimes more. The rows could go up to 55,000. I hope this is a
little more clear so the problem can be resolved.

The code listed in the initial posting & response is displaying the
output equal to Sheet 4(Current Macro results). Cell on Col B on the
same line as the Col C:P information is blank(",,").

Sheet1
EID,TSECRET,EmployeeId,Lawid,SSN-4,Associate,EmployeeName
VXK031,,104852,,1733,Y,Dunn,Robert J.
QEM893,,127901,,5011,Y,Racker,Doretta S.
SPE533,,128194,,2462,Y,Son,Richard T
LAF321,,161631,,016A,N,Well,Mark Adam
XMA505,,188075,18864,1882,Y,XAUTREAY,TRAVIS SCOTT
YEQ957,,388869,,8887,Y,Frazier,Verlon Jo
ZKB886,,288837,,7883,Y,Smith,Sandra Mott

Sheet2
Eid,TSecret
XMA505,XMA505P,XAUTREAY, TRAVIS S
XMA505,E018864
YEQ957,YEQ957N,FRAZIER, VERLON J
YEQ957,YEQ957T
ZKB886,ZKB886N,Smith, SANDRA M
ZKB886,ZKB886P
ZKB886,ZKB886T


Sheet4: Finished(Manually done by hand). Here is what is what I want:
EID,TSecret,EmployeeId,Lawid,SSN-4,Associate,EmployeeName
XMA505,XMA505P,188075,18864,1882,Y,XAUTREAY,TRAVIS SCOTT
XMA505,E018864,188075,18864,1882,Y,XAUTREAY,TRAVIS SCOTT
YEQ957,YEQ957N,388869,8887,Y,Frazier,Verlon Jo
YEQ957,YEQ957T,388869,8887,Y,Frazier,Verlon Jo
ZKB886,ZKB886N,288837,7883,Y,Smith,Sandra Mott
ZKB886,ZKB886P,288837,7883,Y,Smith,Sandra Mott
ZKB886,ZKB886T,288837,7883,Y,Smith,Sandra Mott

Sheet4:Current Macro Results:
EID,TSecret,EmployeeId,Lawid,SSN-4,Associate,EmployeeName
XMA505,,188075,18864,1882,Y,XAUTREAY,TRAVIS SCOTT
XMA505,XMA505P
XMA505,E018864
YEQ957,,388869,,8887,Y,Frazier,Verlon Jo
YEQ957,YEQ957N
YEQ957,YEQ957T
ZKB886,,288837,,7883,Y,Smith,Sandra Mott
ZKB886,ZKB886N
ZKB886,ZKB886P
ZKB886,ZKB886T

I was busy today and just got some time to look at this problem. The code
wasn't difficult. Simplier than you explanation. I didn't get exactly the
results you posted but the results you posted didn't seem to give consitent
results.

I simply performed the followig steps
1) Copy Columns A and B from sheet 2 to sheet 3
2) Copied header row from sheet 1
3) Looped through each row in sheet 3 looking at the EID in column A
(orignally from sheet 2)
a) Found each EID in sheet 1 and copied colums C - H to sheet 3.


Sub Duplicates()
'
' NOTE: The macro assumes there is a header in the both worksheets
' The macro starts at row 2 and sort data automatically
'
ScreenUpdating = False

'copy sheet 2 column A & B to sheet 3
With Sheets("Sheet3")
'clear sheet 3
.Cells.ClearContents

Sheets("Sheet2").Columns("A:B").Copy _
Destination:=.Columns("A")

'copy header row from sheet 1
Sheets("Sheet1").Rows(1).Copy _
Destination:=.Rows(1)

RowCount = 2

Do While .Range("A" & RowCount) < ""
EID = .Range("A" & RowCount)

With Sheets("Sheet1")
Set c = .Columns("A").Find(what:=EID, _
LookIn:=xlValues, lookat:=xlWhole)

If Not c Is Nothing Then
Set Copyrange = _
.Range(.Range("C" & c.Row), _
.Range("H" & c.Row))
Copyrange.Copy _
Destination:=Sheets("Sheet3").Range("C" & RowCount)
End If
End With
RowCount = RowCount + 1
Loop
End With

ScreenUpdating = True

End Sub


"Ty" wrote:

On Aug 20, 4:25 am, Joel wrote:
Can you post samples of the data you are starting with and the results you
are actaull looking for. Your description isn't any better the your
prevvious postinggs and without actual data I don't think you will get the
results you are looking for.

My previous code worked except you where unhappy with the column b data that
was put in the destination sheet. Sheet 1 column B didn't have the data you
were looking for. You wanted my to put the sheet 2 column B data into column
B in the destination sheet. But column B in sheet 2 had various didfferent
results.

People should read your previous posting before trying to solve this problem

http://www.microsoft.com/office/comm....mspx?&query=T....

This is the results I think will work from my previous posting

Sub Duplicates()
'
' NOTE: The macro assumes there is a header in the both worksheets
' The macro starts at row 2 and sort data automatically
'
ScreenUpdating = False

'copy sheet 1 to sheet 3
With Sheets("Sheet3")
Sheets("Sheet1").Cells.Copy _
Destination:=.Cells

'find last row
LastRowA = .Range("A" & Rows.Count).End(xlUp).Row
LastRowB = .Range("B" & Rows.Count).End(xlUp).Row

If LastRowA LastRowB Then
LastRow = LastRowA
Else
LastRow = LastRowB
End If

NewRow = LastRow + 1

With Sheets("Sheet2")
'find last row
LastRow2 = .Range("A" & Rows.Count).End(xlUp).Row
End With

'copy sheet 2 to end of sheet 3, only columns A & B
Sheets("Sheet2").Range("A1:B" & LastRow2).Copy _
Destination:=.Range("A" & NewRow)

'Sort Data
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Rows("1:" & LastRow).Sort _
header:=xlYes, _
Key1:=.Range("A1"), _
order1:=xlAscending

'Mark row which aren't duplicates so they can be removed

RowCount = 3
Do While .Range("A" & RowCount) < ""
'check if ID matches either previous or next row
If .Range("A" & RowCount) < .Range("A" & (RowCount - 1)) And _
.Range("A" & RowCount) < .Range("A" & (RowCount + 1)) Then

.Range("IV" & RowCount) = "X"

End If
RowCount = RowCount + 1
Loop

'put anything in cell IV1 so filter works properly
.Range("IV1") = "Anything"
'filter on x's
.Columns("IV:IV").AutoFilter
.Columns("IV:IV").AutoFilter Field:=1, Criteria1:="X"

Set VisibleRows = .Rows("2:" & LastRow) _
.SpecialCells(xlCellTypeVisible)
'delete rows with X's
VisibleRows.Delete
'turn off autfilter
.Columns("IV:IV").AutoFilter
'clear IV1
.Range("IV1").Clear

End With

ScreenUpdating = True

End Sub



"Ty" wrote:
I have received plenty of help from here with several macro's
attempting to solve my problem. But the problem was never resolved.
Most of it is my fault. After reviewing the macro's and my original
description of my problem, I am trying to make another post that might
actually solve my problem. The last attempt worked ok except for the
fact I left part of the end results of the previous macro on my sheet
1. (read below) After the sort, it was reading the data at the bottom
of sheet 1:col B and placing it on Sheet 4. And that data was used to
come up with a solution. When I deleted the data:Col B from the other
Macro, there was no Col B data on Sheet 4 when the final macro(below)
was ran. After chatting with one of the MVP's. Here is what I need:

VLookup will not work because it will only return 1 item. I have
multiple items for 1 match in most cases. Example: 1 employee might
have 4 id's. I have a file if someone wants it.

For each item in col A of sheet2 I want to look for a match in col A
of sheet 1. If there is a match I want(all)="that cell"="that item" of
the row:col B of Sheet2 copied to Col B sheet 4. Etc I then want?

This is the tricky part:
For each item in col A of sheet2 I want to look for a match in col A
of sheet 1. If there is a match I want(all) of the row:col C to col P
of Sheet1 copied to sheet 3.

In other words:

I want info from sheet 1 cells in Col A that match cells A:B in Sheet
2_____ to be put in sheet 4.

I want info from sheet 1 cells in Col C to Col P that match cells A:
in Sheet 4_____ to be put in sheet 4 where? in col C to col P.

Here is the last piece of code but I know everyone writes differently:

Option Explicit
Sub MakeDestinationSheet()
Dim n
Dim c
Dim lr, slr, ifshtlr As Long
Dim srcsht, ifsht, destsht As Worksheet
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Set srcsht = Sheets("sheet1")
Set ifsht = Sheets("sheet2")
ifshtlr = ifsht.Cells(Rows.Count, 1).End(xlUp).Row

Set destsht = Sheets("Sheet4")
destsht.Select

With destsht
lr = .Cells(Rows.Count, 1).End(xlUp).Row
..Rows(2).Resize(lr).Delete

For Each n In ifsht.Range("a2:a" & ifshtlr)
Set c = destsht.Columns(1).Find(n, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If c Is Nothing Then
slr = srcsht.Cells(Rows.Count, 1).End(xlUp).Row
With srcsht.Range("A4:p" & slr)
.AutoFilter Field:=1, Criteria1:=n
lr = destsht.Cells(Rows.Count, 1).End(xlUp).Row + 1
slr = srcsht.Cells(Rows.Count, 1).End(xlUp).Row
srcsht.Range("a5:p" & slr).Copy destsht.Cells(lr, 1)
..AutoFilter
End With

End If
Next n
.Range(Cells(2, "c"), Cells(lr + 1, "p")).SpecialCells
(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
.Range(Cells(2, "j"), Cells(lr + 1, "k")).NumberFormat = "mm/dd/yyyy"
.Range(Cells(2, "c"), Cells(lr + 1, "p")).Value = _
.Range(Cells(2, "c"), Cells(lr + 1, "p")).Value
.Columns("b").SpecialCells(xlCellTypeBlanks).Entir eRow.Delete
.Columns("L").Style = "Comma"
.Columns.AutoFit

End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Warm regards,
Ty- Hide quoted text -

- Show quoted text -

First, thanks for the help. Here are some samples of the data. It's
difficult to place the data in .txt in here. I used the comma so you
can Import it into Excel using the "," as a delimiter. The ",," are
blank cells. In most lines down below, ",," is the ColB. Just fyi--
down below the fullname has a comma in 1 full cell on the original SS-
spreadsheet. The real columns on Sheet 1 go all the way to Col P and
sometimes more. The rows could go up to 55,000. I hope this is a
little more clear so the problem can be resolved.

The code listed in the initial posting & response is displaying the
output equal to Sheet 4(Current Macro results). Cell on Col B on the
same line as the Col C:P information is blank(",,").

Sheet1
EID,TSECRET,EmployeeId,Lawid,SSN-4,Associate,EmployeeName
VXK031,,104852,,1733,Y,Dunn,Robert J.
QEM893,,127901,,5011,Y,Racker,Doretta S.
SPE533,,128194,,2462,Y,Son,Richard T
LAF321,,161631,,016A,N,Well,Mark Adam
XMA505,,188075,18864,1882,Y,XAUTREAY,TRAVIS SCOTT
YEQ957,,388869,,8887,Y,Frazier,Verlon Jo
ZKB886,,288837,,7883,Y,Smith,Sandra Mott

Sheet2
Eid,TSecret
XMA505,XMA505P,XAUTREAY, TRAVIS S
XMA505,E018864
YEQ957,YEQ957N,FRAZIER, VERLON J
YEQ957,YEQ957T
ZKB886,ZKB886N,Smith, SANDRA M
ZKB886,ZKB886P
ZKB886,ZKB886T


Sheet4: Finished(Manually done by hand). Here is what is what I want:
EID,TSecret,EmployeeId,Lawid,SSN-4,Associate,EmployeeName
XMA505,XMA505P,188075,18864,1882,Y,XAUTREAY,TRAVIS SCOTT
XMA505,E018864,188075,18864,1882,Y,XAUTREAY,TRAVIS SCOTT
YEQ957,YEQ957N,388869,8887,Y,Frazier,Verlon Jo
YEQ957,YEQ957T,388869,8887,Y,Frazier,Verlon Jo
ZKB886,ZKB886N,288837,7883,Y,Smith,Sandra Mott
ZKB886,ZKB886P,288837,7883,Y,Smith,Sandra Mott
ZKB886,ZKB886T,288837,7883,Y,Smith,Sandra Mott

Sheet4:Current Macro Results:
EID,TSecret,EmployeeId,Lawid,SSN-4,Associate,EmployeeName
XMA505,,188075,18864,1882,Y,XAUTREAY,TRAVIS SCOTT
XMA505,XMA505P
XMA505,E018864
YEQ957,,388869,,8887,Y,Frazier,Verlon Jo
YEQ957,YEQ957N
YEQ957,YEQ957T
ZKB886,,288837,,7883,Y,Smith,Sandra Mott
ZKB886,ZKB886N
ZKB886,ZKB886P
ZKB886,ZKB886T

On Aug 20, 7:34*pm, Joel wrote:
I was busy today and just got some time to look at this problem. *The code
wasn't difficult. *Simplier than you explanation. I didn't get exactly the
results you posted but the results you posted didn't seem to give consitent
results.

I simply performed the followig steps
1) Copy Columns A and B from sheet 2 to sheet 3
2) Copied header row from sheet 1
3) Looped through each row in sheet 3 looking at the EID in column A
(orignally from sheet 2)
* * a) Found each EID in sheet 1 and copied colums C - H to sheet 3.

Sub Duplicates()
* *'
* *' NOTE: The macro assumes there is a header in the both worksheets
* *' * * * The macro starts at row 2 and sort data automatically
* *'
* *ScreenUpdating = False

* *'copy sheet 2 column A & B to sheet 3
* *With Sheets("Sheet3")
* * * 'clear sheet 3
* * * .Cells.ClearContents

* * * Sheets("Sheet2").Columns("A:B").Copy _
* * * * *Destination:=.Columns("A")

* * * 'copy header row from sheet 1
* * * Sheets("Sheet1").Rows(1).Copy _
* * * * *Destination:=.Rows(1)

* * * RowCount = 2

* * * Do While .Range("A" & RowCount) < ""
* * * * *EID = .Range("A" & RowCount)

* * * * *With Sheets("Sheet1")
* * * * * * Set c = .Columns("A").Find(what:=EID, _
* * * * * * * *LookIn:=xlValues, lookat:=xlWhole)

* * * * * * If Not c Is Nothing Then
* * * * * * * *Set Copyrange = _
* * * * * * * * * .Range(.Range("C" & c.Row), _
* * * * * * * * * * *.Range("H" & c.Row))
* * * * * * * *Copyrange.Copy _
* * * * * * * * * Destination:=Sheets("Sheet3").Range("C" & RowCount)
* * * * * * End If
* * * * *End With
* * * * *RowCount = RowCount + 1
* * * Loop
* *End With

* *ScreenUpdating = True

End Sub



"Ty" wrote:
On Aug 20, 4:25 am, Joel wrote:
Can you post samples of the data you are starting with and the results you
are actaull looking for. *Your description isn't any better the your
prevvious postinggs and without actual data I don't think you will get the
results you are looking for.

My previous code worked except you where unhappy with the column b data that
was put in the destination sheet. *Sheet 1 column B didn't have the data you
were looking for. *You wanted my to put the sheet 2 column B data into column
B in the destination sheet. *But column B in sheet 2 had various didfferent
results.

People should read your previous posting before trying to solve this problem

http://www.microsoft.com/office/comm....mspx?&query=T....

This is the results I think will work from my previous posting

Sub Duplicates()
* *'
* *' NOTE: The macro assumes there is a header in the both worksheets
* *' * * * The macro starts at row 2 and sort data automatically
* *'
* *ScreenUpdating = False

* *'copy sheet 1 to sheet 3
* *With Sheets("Sheet3")
* * * Sheets("Sheet1").Cells.Copy _
* * * * *Destination:=.Cells

* * * 'find last row
* * * LastRowA = .Range("A" & Rows.Count).End(xlUp).Row
* * * LastRowB = .Range("B" & Rows.Count).End(xlUp).Row

* * * If LastRowA LastRowB Then
* * * * *LastRow = LastRowA
* * * Else
* * * * *LastRow = LastRowB
* * * End If

* * * NewRow = LastRow + 1

* * * With Sheets("Sheet2")
* * * * *'find last row
* * * * *LastRow2 = .Range("A" & Rows.Count).End(xlUp).Row
* * * End With

* * * 'copy sheet 2 to end of sheet 3, only columns A & B
* * * Sheets("Sheet2").Range("A1:B" & LastRow2).Copy _
* * * * *Destination:=.Range("A" & NewRow)

* * * 'Sort Data
* * * LastRow = .Range("A" & Rows.Count).End(xlUp).Row
* * * .Rows("1:" & LastRow).Sort _
* * * * *header:=xlYes, _
* * * * *Key1:=.Range("A1"), _
* * * * *order1:=xlAscending

* * * 'Mark row which aren't duplicates so they can be removed

* * * RowCount = 3
* * * Do While .Range("A" & RowCount) < ""
* * * * *'check if ID matches either previous or next row
* * * * *If .Range("A" & RowCount) < .Range("A" & (RowCount - 1)) And _
* * * * * * .Range("A" & RowCount) < .Range("A" & (RowCount + 1)) Then

* * * * * * .Range("IV" & RowCount) = "X"

* * * * *End If
* * * * *RowCount = RowCount + 1
* * * Loop

* * * 'put anything in cell IV1 so filter works properly
* * * .Range("IV1") = "Anything"
* * * 'filter on x's
* * * .Columns("IV:IV").AutoFilter
* * * .Columns("IV:IV").AutoFilter Field:=1, Criteria1:="X"

* * * Set VisibleRows = .Rows("2:" & LastRow) _
* * * * *.SpecialCells(xlCellTypeVisible)
* * * 'delete rows with X's
* * * VisibleRows.Delete
* * * 'turn off autfilter
* * * .Columns("IV:IV").AutoFilter
* * * 'clear IV1
* * * .Range("IV1").Clear

* *End With

* *ScreenUpdating = True

End Sub

"Ty" wrote:
I have received plenty of help from here with several macro's
attempting to solve my problem. *But the problem was never resolved.
Most of it is my fault. *After reviewing the macro's and my original
description of my problem, I am trying to make another post that might
actually solve my problem. *The last attempt worked ok except for the
fact I left part of the end results of the previous macro on my sheet
1. *(read below) After the sort, it was reading the data at the bottom
of sheet 1:col B and placing it on Sheet 4. *And that data was used to
come up with a solution. *When I deleted the data:Col B from the other
Macro, there was no Col B data on Sheet 4 when the final macro(below)
was ran. *After chatting with one of the MVP's. *Here is what I need:

VLookup will not work because it will only return 1 item. *I have
multiple items for 1 match in most cases. *Example: *1 employee might
have 4 id's. *I have a file if someone wants it.

For each item in *col A of sheet2 I want to look for a match in col A
of sheet 1. If there is a match I want(all)="that cell"="that item" of
the row:col B of Sheet2 copied to Col B sheet 4. Etc I then want?

This is the tricky part:
For each item in *col A of sheet2 I want to look for a match in col A
of sheet 1. If there is a match I want(all) of the row:col C to col P
of Sheet1 copied to sheet 3.

In other words:

I want info from sheet 1 cells in Col A that match cells A:B in Sheet
2_____ to be put *in sheet 4.

I want info from sheet 1 cells in Col C to Col P that match cells A:
in Sheet 4_____ to be put *in sheet 4 where? in col C to col P.

Here is the last piece of code but I know everyone writes differently:

Option Explicit
Sub MakeDestinationSheet()
Dim n
Dim c
Dim lr, slr, ifshtlr As Long
Dim srcsht, ifsht, destsht As Worksheet
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Set srcsht = Sheets("sheet1")
Set ifsht = Sheets("sheet2")
ifshtlr = ifsht.Cells(Rows.Count, 1).End(xlUp).Row

Set destsht = Sheets("Sheet4")
destsht.Select

With destsht
lr = .Cells(Rows.Count, 1).End(xlUp).Row
..Rows(2).Resize(lr).Delete

For Each n In ifsht.Range("a2:a" & ifshtlr)
Set c = destsht.Columns(1).Find(n, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If c Is Nothing Then
slr = srcsht.Cells(Rows.Count, 1).End(xlUp).Row
With srcsht.Range("A4:p" & slr)
* * .AutoFilter Field:=1, Criteria1:=n
lr = destsht.Cells(Rows.Count, 1).End(xlUp).Row + 1
slr = srcsht.Cells(Rows.Count, 1).End(xlUp).Row
srcsht.Range("a5:p" & slr).Copy destsht.Cells(lr, 1)
..AutoFilter
End With

End If
Next n
*.Range(Cells(2, "c"), Cells(lr + 1, "p")).SpecialCells
(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
*.Range(Cells(2, "j"), Cells(lr + 1, "k")).NumberFormat = "mm/dd/yyyy"
*.Range(Cells(2, "c"), Cells(lr + 1, "p")).Value = _
*.Range(Cells(2, "c"), Cells(lr + 1, "p")).Value
*.Columns("b").SpecialCells(xlCellTypeBlanks).Enti reRow.Delete
*.Columns("L").Style = "Comma"
*.Columns.AutoFit

End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Warm regards,
Ty- Hide quoted text -

- Show quoted text -

First, thanks for the help. *Here are some samples of the data. *It's
difficult to place the data in .txt in here. *I used the comma so you
can Import it into Excel using the "," as a delimiter. *The ",," are
blank cells. *In most lines down below, ",," is the ColB. Just fyi--
down below the fullname has a comma in 1 full cell on the original SS-
spreadsheet. *The real columns on Sheet 1 go all the way to Col P and
sometimes more. *The rows could go up to 55,000. *I hope this is a
little more clear so the problem can be resolved.

The code listed in the initial posting & response is displaying the
output equal to Sheet 4(Current Macro results). Cell on Col B on the
same line as the Col C:P information is blank(",,").

Sheet1
EID,TSECRET,EmployeeId,Lawid,SSN-4,Associate,EmployeeName
VXK031,,104852,,1733,Y,Dunn,Robert J.
QEM893,,127901,,5011,Y,Racker,Doretta S.
SPE533,,128194,,2462,Y,Son,Richard T
LAF321,,161631,,016A,N,Well,Mark Adam
XMA505,,188075,18864,1882,Y,XAUTREAY,TRAVIS SCOTT
YEQ957,,388869,,8887,Y,Frazier,Verlon Jo
ZKB886,,288837,,7883,Y,Smith,Sandra Mott

Sheet2
Eid,TSecret
XMA505,XMA505P,XAUTREAY, TRAVIS S
XMA505,E018864
YEQ957,YEQ957N,FRAZIER, VERLON J
YEQ957,YEQ957T
ZKB886,ZKB886N,Smith, SANDRA M
ZKB886,ZKB886P
ZKB886,ZKB886T

Sheet4: Finished(Manually done by hand). *Here is what is what I

...

read more »- Hide quoted text -

- Show quoted text -

I used it on several spreadsheets. Thanks for the help.