Create a data set from 2 different lists

[deeds]

I am trying to create one new list of matching data...I need to look at one
cell in one sheet and look to another sheet (column) and see if it shows up
there...if it does, I need to bring back the entire row of data for that
item...to a new sheet to start the "matching" list. Is there a way to do
something like this? I have done the vlookup thing and found the data that
matches....however, now I have to go through sort, and delete the ones that
don't match. I was wondering if someone has a shortcut. Hope I explained it
ok...Thanks.

In other words....2 sets of data, find the matching data (lets say one
cell), on a new sheet, start the list of matching data.

 

[Tom Ogilvy]

Sub ABC()
Dim sh1 as Worksheet, sh2 as Worksheet
Dim sh3 as Worksheet, rng1 as Range
dim rng2 as Range, cell as Range
Dim rw as Long
set sh1 = worksheets("Sheet1")
set sh2 = worksheets("Sheet2")
worksheets.add after:=Worksheets(worksheets.count)
set sh3 = Activesheet
sh3.Name = "Matches"
with sh1
set rng1 = .Range(.cells(2,1),.cells(2,1).End(xldown))
End with

with sh2
set rng2 = .Range(.cells(2,1),.cells(2,1).End(xldown))
End with

rw = 2
for each cell in rng1
if application.Countif(rng2,cell) > 0 then
sh3.cells(rw,1).Value = cell.Value
rw = rw + 1
end if
Next
End Sub

 

[deeds]

Thanks Tom! That works..however, now, how do I get all of the data with that
matched figure...in other words, I need the entire row of data that is with
the matched data, so it finds the match in let's say A1, I also need to bring
back the other data in that row....any ideas? Thanks again!

 

[Tom Ogilvy]

from which worksheet?

if from sheet1:
Sub ABC()
Dim sh1 as Worksheet, sh2 as Worksheet
Dim sh3 as Worksheet, rng1 as Range
dim rng2 as Range, cell as Range
Dim rw as Long
set sh1 = worksheets("Sheet1")
set sh2 = worksheets("Sheet2")
worksheets.add after:=Worksheets(worksheets.count)
set sh3 = Activesheet
sh3.Name = "Matches"
with sh1
set rng1 = .Range(.cells(2,1),.cells(2,1).End(xldown))
End with

with sh2
set rng2 = .Range(.cells(2,1),.cells(2,1).End(xldown))
End with

rw = 2
for each cell in rng1
if application.Countif(rng2,cell) > 0 then
cell.EntireRow.copy sh3.cells(rw,1)
rw = rw + 1
end if
Next
End Sub


If it is from sheet2 you need to copy the data, then just reverse these
lines
set sh1 = worksheets("Sheet1")
set sh2 = worksheets("Sheet2")

becomes
set sh2 = worksheets("Sheet1")
set sh1 = worksheets("Sheet2")

 

[deeds]

Thanks Tom!....I made this work.....works great!

from which worksheet?

if from sheet1:
Sub ABC()
Dim sh1 as Worksheet, sh2 as Worksheet
Dim sh3 as Worksheet, rng1 as Range
dim rng2 as Range, cell as Range
Dim rw as Long
set sh1 = worksheets("Sheet1")
set sh2 = worksheets("Sheet2")
worksheets.add after:=Worksheets(worksheets.count)
set sh3 = Activesheet
sh3.Name = "Matches"
with sh1
set rng1 = .Range(.cells(2,1),.cells(2,1).End(xldown))
End with

with sh2
set rng2 = .Range(.cells(2,1),.cells(2,1).End(xldown))
End with

rw = 2
for each cell in rng1
if application.Countif(rng2,cell) > 0 then
cell.EntireRow.copy sh3.cells(rw,1)
rw = rw + 1
end if
Next
End Sub


If it is from sheet2 you need to copy the data, then just reverse these
lines
set sh1 = worksheets("Sheet1")
set sh2 = worksheets("Sheet2")

becomes
set sh2 = worksheets("Sheet1")
set sh1 = worksheets("Sheet2")