help on find and copy

[carlos]

Greetings,

I've a workbook with three sheets (sheet1, sheet2 and "search results")

sheet1:

There are two columns in sheet1 with more than 2000 rows!

employee_ID Borowed_books
0e100 JChase-203
oe100 RUdlum-40
oe098 RUdlum-22
oe101 Achristi-53
oe100 JChase-06
oe098 Mpuzo-22
oe100 Pmason-42

Sheet2:

column a has list of employee id that belongs to a particular department

Employee_ID Dept Manager
oe098 xx Tom
oe099 xx Jerry
0200 xx Jerry
oe407 xx Tom
0e100


I want to pickup all cells under employee_id in sheet2 and search sheet 1
if a hit is found then copy entire row to "search results" sheet.

In the above example, the search should find oe098 (two rows) and oe100 (4
rows).. and "search result" sheet should contain 6 rows.

Any help is greatly appreciated.

Regards
Carlos

 

[merjet]

Sub MySearch()
Dim c As Range
Dim rng As Range
Dim c1 As Range
Dim rng1 As Range
Dim iEnd As Integer
Dim iRow As Integer

iEnd = Sheets("Sheet1").Range("A1").End(xlDown).Row
Set rng1 = Sheets("Sheet1").Range("A2:A" & iEnd)
iEnd = Sheets("Sheet2").Range("A1").End(xlDown).Row
Set rng = Sheets("Sheet2").Range("A2:A" & iEnd)
iRow = 1
For Each c In rng
For Each c1 In rng1
If c = c1 Then
iRow = iRow + 1
Sheets("search results").Cells(iRow, 1) = c1
Sheets("search results").Cells(iRow, 2) = c1.Offset(0, 1)
End If
Next c1
Next c
End Sub

Hth,
Merjet

 

[carlos]

Hello again,

How to modify the below code for my requirement?

Regards

Carlos

This code sample searches the columns of a worksheet for the occurrence of a
word ("Hello"). Once matching data is found, it is copied to another
worksheet ("Search Results").

Copy Code
Sub FindMe()
Dim intS As Integer
Dim rngC As Range
Dim strToFind As String, FirstAddress As String
Dim wSht As Worksheet

Application.ScreenUpdating = False

intS = 1
'This step assumes that you have a worksheet named
'Search Results.
Set wSht = Worksheets("Search Results")
strToFind = "Hello"

'Change this range to suit your own needs.
With ActiveSheet.Range("A1:C2000")
Set rngC = .Find(what:=strToFind, LookAt:=xlPart)
If Not rngC Is Nothing Then
FirstAddress = rngC.Address
Do
rngC.EntireRow.Copy wSht.Cells(intS, 1)
intS = intS + 1
Set rngC = .FindNext(rngC)
Loop While Not rngC Is Nothing And rngC.Address <>
FirstAddress
End If
End With

End Sub

 

[carlos]

Greetings,

Thank you very much Merjet.

It's working fine.

Regards
Carlos