PDA

View Full Version : [SOLVED] Searching and Copying



chocho
01-24-2013, 09:31 PM
Hi,

I have attached a sample file with input and output. Basically what I am looking for is to search for each term in column 1 of sheet2, and paste that row from sheet 1 into sheet 3 (and delete a column in the process but I can do this myself). Thanks for your help in advance!

mancubus
01-25-2013, 07:14 AM
hi chocho.
try this.


Sub Copy_Rows_Based_On_Condition()
Dim SearchRange As Range
Dim LastRow As Long, i As Long
With Worksheets("Sheet2")
Set SearchRange = .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row)
End With
With Worksheets("Sheet1")
.Rows(1).Copy Worksheets("Sheet3").Range("A1") 'first copy header row
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Application.CountIf(SearchRange, .Range("A" & i)) > 0 Then
.Rows(i).Copy Worksheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
End With
Worksheets("Sheet3").Columns("B").Delete
End Sub

chocho
01-25-2013, 10:06 AM
Thanks so much! Worked like a charm. I was trying to use the .find function as so (I thought it would be more robust and flexible):


SearchRow = Cells.Find(What:=r.Value, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Row

But I kept getting different errors.

mancubus
01-25-2013, 01:38 PM
you're welcome.
try this.



Sub Copy_Rows_Based_On_Condition_FindMethod()
Dim SearchRange As Range, FoundCell As Range
Dim LastRow As Long, i As Long
With Worksheets("Sheet2")
Set SearchRange = .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row)
End With
With Worksheets("Sheet1")
.Rows(1).Copy Worksheets("Sheet3").Range("A1") 'first copy header row
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To LastRow
On Error Resume Next
Set FoundCell = SearchRange.Find(What:=.Cells(i, 1), After:=SearchRange.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
On Error GoTo 0
If Not FoundCell Is Nothing Then
.Rows(i).Copy Worksheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
End With
Worksheets("Sheet3").Columns("B").Delete
End Sub

chocho
01-25-2013, 03:39 PM
Thanks! Some tweaking an I think I can get this to work