|
Copy an entire row based on value in one cell
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 |
Copy an entire row based on value in one cell
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 "Nigel" wrote in message ... 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 -- Regards, Nigel "SueJB" wrote in message ... 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 |
Copy an entire row based on value in one cell
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 "Nigel" wrote: 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 "Nigel" wrote in message ... 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 -- Regards, Nigel "SueJB" wrote in message ... 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 |
| All times are GMT +1. The time now is 02:09 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com