If I were doing it manually, I'd apply an autofilter on sheet2 for each value in
sheet1 (custom|contains). Then copy those rows to the new sheet.
In a macro:
Option Explicit
Sub testme()
Dim mstrWks As Worksheet
Dim subWks As Worksheet
Dim rptWks As Worksheet
Dim mstrRng As Range
Dim subRng As Range
Dim subRngF As Range
Dim myCol As String
Dim myCell As Range
Dim oRow As Long
Set mstrWks = Worksheets("sheet1")
Set subWks = Worksheets("sheet2")
Set rptWks = Worksheets.Add
rptWks.Range("a1").Resize(1, 2).Value = Array("record number", "access")
myCol = "B"
With mstrWks
Set mstrRng = .Range(.Cells(2, myCol), _
.Cells(.Rows.Count, myCol).End(xlUp))
End With
With subWks
Set subRng = .Range(.Cells(1, myCol), _
.Cells(.Rows.Count, myCol).End(xlUp))
.AutoFilterMode = False
End With
oRow = 2
For Each myCell In mstrRng.Cells
subRng.AutoFilter field:=1, Criteria1:="*" & myCell.Value & "*"
If subRng.Cells.SpecialCells(xlCellTypeVisible).Cells .Count = 1 Then
'do nothing
Else
myCell.EntireRow.Copy _
Destination:=rptWks.Cells(oRow, "A")
oRow = oRow + 1
With subRng
Set subRngF = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.Cells.SpecialCells(xlCellTypeVisible)
End With
subRngF.EntireRow.Copy _
Destination:=rptWks.Cells(oRow, 1)
oRow = oRow + subRngF.Cells.Count + 1
End If
Next myCell
subWks.AutoFilterMode = False
rptWks.UsedRange.Columns.AutoFit
End Sub
I used column B as my Access column. And if a value in sheet2 has two words in
the list, it'll show up in both areas???? (It will with this code!)
Simon wrote:
SHEET 1
record number access
1 red
2 yellow
3 blue
4 grey
5 white
6 black
SHEET 2
record number access
a thecatwasblue
b blackdogs
c red
d twoblackdogs
e onewhitesock
I need to find every occurance of each cell in the
the 'Access' column of SHEET 1 in the 'Access' column of
SHEET 2.
I then want to copy the entire row of SHEET 1 into SHEET 3
and then copy all the rows that the text appears in
within SHEET 2 into SHEET 3 - bellow the SHEET 1 Copy.
RESULT SHEET 3
record number access
1 red
c red
3 blue
a thecatwasblue
5 white
e onewhitesock
6 black
b blackdogs
d twoblackdogs
Can anyone help me please.
Many Thanks,
Simon
--
Dave Peterson