Find and move rows

I need help with a macro that can check sheet 1 which has content as this

http://i72.photobucket.com/albums/i173/or.jpg
http://i72.photobucket.com/albums/i173/ssor.jpg
http://i72.photobucket.com/albums/i173/rror.jpg

Column A has this

Sheet 2 has many columns of data and many rows

Need to search full content and move the complete row if found as column A of sheet 1 to sheet 3

Whole row should be copied or cut either ways is fine with me

LVL 11

bsharathAsked: 2012-12-27

Who is Participating?

Solutions

LVL 43

Saqib Husain, SyedConnect With a Mentor EngineerCommented: 2012-12-28

Try this .... not tested

Sub getfoundurls()
    Dim cel As Range, fs2 As Range
    For Each cel In Sheet1.UsedRange.Columns(1).Cells
        Set fs2 = Sheet2.UsedRange.Find(cel, , , xlWhole)
        If Not fs2 Is Nothing Then
            fs2.EntireRow.Copy Sheet3.Cells.SpecialCells(xlCellTypeLastCell).Offset(1).EntireRow
        else 
            cel.interior.color = 255
        End If
    Next cel

Open in new window

End Sub

LVL 2

hanklmCommented: 2012-12-27

FYI: The image links don't seem work - at least not for me.

I get redirected here: http://beta.photobucket.com/browse?httpstatus=404

Maybe it's just a temporary issue?

LVL 43

Saqib Husain, SyedEngineerCommented: 2012-12-27

It would be better if you upload the files on experts-exchange.

Better still if you can upload an excel file (possibly fictitious) so that direct testing could be done instead of rebuilding the data.

LVL 11

bsharathAuthor Commented: 2012-12-27

The links are dummy that i placed

These URl's 100's will be in sheet1 column A

Find each in sheet 2 and copy full row to sheet 3

LVL 11

bsharathAuthor Commented: 2012-12-28

Any help with this please?

LVL 43

Saqib Husain, SyedEngineerCommented: 2012-12-28

Please throw in a sample file to work on.

LVL 11

bsharathAuthor Commented: 2012-12-28

Please find attached sample file
Sample.xls

LVL 43

Saqib Husain, SyedEngineerCommented: 2012-12-28

Here you go

Sub getfoundurls()
Dim cel As Range, fs2 As Range
For Each cel In Sheet1.UsedRange.Columns(1).Cells
Set fs2 = Sheet2.UsedRange.Find(cel, , , xlWhole)
If Not fs2 Is Nothing Then
fs2.EntireRow.Copy Sheet3.Cells.SpecialCells(xlCellTypeLastCell).Offset(1).EntireRow
End If
Next cel
End Sub