Copy an entire row based on value in one cell

[SueJB]

APOLOGIES IF THIS IS A DUPLICATE POSTING - SYSTEM PROBLEMS!

Hello all

I hope you'll forgive me if this is answered somewhere in the archives, I've
looked right through but can't find anything and have time constraints.

I have working code that:
- cycles through a spreadsheet row by row
- if it finds a predetermined value anywhere in the row, it copies that
entire row to a new spreadsheet

the code is:

Sheets("Report data").Activate

firstRow = 1
lastRow = Range("A60000").End(xlUp).Row

For r = firstRow To lastRow

Set c = Rows(r).Find("Infrastructure") ****
If Not c Is Nothing Then
Rows(r).Copy
Sheets("Infrastructure").Activate
Range("A65000").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
Range("A65000").End(xlUp).Offset(0, 0).PasteSpecial (xlPasteFormats)
Sheets("Report data").Activate
End If
Next r

Sheets("Infrastructure").Activate
Range("a1").Select
Application.CutCopyMode = False
Application.StatusBar = False


I need to amend it so that it only copies the row if the required value is
in Column I of the row (so excluding any where it appears elsewhere, say in
colum A).

Can I do this by amending the line marked **** ? I've tried lots of
variations without success.

As ever, thanks in advance for any responses.

SJB

 

[Nigel]

Replace these two rows

Set c = Rows(r).Find("Infrastructure") ****
If Not c Is Nothing Then

with this

If Trim(Cells(r,"I")) = "Infrastructure" then

 

[Nigel]

I just realized that you may be looking for the string within the cell? So
change the code from

If Trim(Cells(r,"I")) = "Infrastructure" then

to

If Instr(1,Cells(r,"I"),"Infrastructure", vbTextCompare) > 0 then



--

Regards,
Nigel
(e-mail address removed)

 

[SueJB]

Nigel

Fantastic, thank you, it worked like a charm and I am now "out from under"!

Sorry to take so long to respond, I really really appreciated your help.

Best wishes
Sue