Create 3rd data set off comparison of 2 other sets

[Ron]

Hoping someone out there can help me with this. I have 2 sheets in the same
wb. I need to be able to compare the 2 sets of data in both sheets and have
them combine on a 3rd sheet. For example.
Sheet 1 has the following data in Column A:

abc
defg
hijk

Sheet 2 has the following data in Column A:

abc
hijk
lmn

I need to somehow to have sheet 3 automatically populate with all the items
that show up on both sheet 1 and sheet 2, but only show up once as in the
example below.

abc
defg
higj
lmn

The amount of data in sheets 1 and 2 will change each time the user updates
the workbook, and I need to have sheet 3 populate automatically, so I don't
know if it can be done through formulas, or if a macro is needed.

Any guidance would be appreciated.

Thanks

 

[joel]

People will give you formulas, but formulas require some manual
operations. A simple macro (simple for me) will do everything
automatic. You can run Advance filters manually and get the same
results as I did below. the process is simple

1) Copy column A on sheet 1 to Column a on sheet 3
2) Copy the Data on sheet 2 to sheet 3 below the data pasted from
sht 1
3) Use Advance filter to copy to a new location (with unique
checked). I used column B on sheet 3.
4) Now delete column A on sheet 3 so the unique values are in colum
A.


Sub CombineSheets()

'copy column A on sheet 1 to column A on sheet 3
Sheets("sheet1").Columns("A").Copy _
Destination:=Sheets("sheet3").Columns("A")

'Get Last row of Sheet 3
With Sheets("sheet3")
Set LastCell = .Range("A" & Rows.Count).End(xlUp)
Set NewCell = LastCell.Offset(1, 0)
End With


'get range of data in sheet 2 column A
With Sheets("sheet2")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set Sht2Range = .Range("A1:A" & LastRow)
End With

'copy data then filer uynique values
With Sheets("sheet3")
Sht2Range.Copy Destination:=NewCell
LastRow = .Range("A" & Rows.Count).End(xlUp).Row

'use advance filter to get unique values
Set DataRange = .Range("A1:A" & LastRow)
DataRange.AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("B1"), _
Unique:=True

'delete column A so unique values are in column A
Columns("A").Delete
End With

End Sub

 

[Ron]

Joel, Macro works great. Is there a way to have it start on a specific row
for copying the data from sheets 1 and 2? The data in sheets 1 and 2 will
always begin in row 6, with headers in rows 1 - 5, which i don't need on
sheet 3.

Thanks

Ron

 

[joel]

try these changes.




VBA Code:
--------------------


Sub CombineSheets()

StartRow = 6
'copy column A on sheet 1 to column A on sheet 3
With Sheets("sheet1")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set Sht1Range = .range("A" & StartRow & ":A" & LastRow)
End With



'get range of data in sheet 2 column A
With Sheets("sheet2")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set Sht2Range = .Range("A" & StartRow & ":A" & LastRow)
End With

'copy data then filter unique values
With Sheets("sheet3")
Sht1Range.Copy Destination:=.Range("A1")
Set LastCell = .Range("A" & Rows.Count).End(xlUp)
Set NewCell = LastCell.Offset(1, 0)
Sht2Range.Copy Destination:=NewCell
LastRow = .Range("A" & Rows.Count).End(xlUp).Row

'use advance filter to get unique values
Set DataRange = .Range("A1:A" & LastRow)
DataRange.AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("B1"), _
Unique:=True

'delete column A so unique values are in column A
.Columns("A").Delete
End With

End Sub

--------------------

 

[Ron]

Works great. Thanks for all your help.

Ron

try these changes.

VBA Code:

Sub CombineSheets()

StartRow = 6
'copy column A on sheet 1 to column A on sheet 3
With Sheets("sheet1")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set Sht1Range = .range("A" & StartRow & ":A" & LastRow)
End With



'get range of data in sheet 2 column A
With Sheets("sheet2")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set Sht2Range = .Range("A" & StartRow & ":A" & LastRow)
End With

'copy data then filter unique values
With Sheets("sheet3")
Sht1Range.Copy Destination:=.Range("A1")
Set LastCell = .Range("A" & Rows.Count).End(xlUp)
Set NewCell = LastCell.Offset(1, 0)
Sht2Range.Copy Destination:=NewCell
LastRow = .Range("A" & Rows.Count).End(xlUp).Row

'use advance filter to get unique values
Set DataRange = .Range("A1:A" & LastRow)
DataRange.AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("B1"), _
Unique:=True

'delete column A so unique values are in column A
.Columns("A").Delete
End With

End Sub

--------------------


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=183144

Microsoft Office Help

.