Find and move rows

bsharath
bsharath used Ask the Experts™
on
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
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
View Solution Only
hanklm

Commented:
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?
Saqib Husain, SyedEngineer

Commented:
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.
bsharath

Author

Commented:
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
Success in ‘20 With a Profitable Pricing Strategy

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Find out now!
bsharath

Author

Commented:
Any help with this please?
Saqib Husain, SyedEngineer

Commented:
Please throw in a sample file to work on.
bsharath

Author

Commented:
Please find attached sample file
Sample.xls
Saqib Husain, SyedEngineer

Commented:
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
bsharath

Author

Commented:
Thanks

Anyway i can color sheet 1 cells whose content is not found in sheet 2 and was skipped
Engineer
Commented:
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
bsharath

Author

Commented:
Thank you

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial