Copying Entire Row if Cell Contains (INSTR)

[chemEE]

Ok, I have been going insane here trying to figure out a code. I'm fairly new to VBA, but not programming in general. Here's my dilemma:

I have ~3000 rows of text in column B. I need to search within each cell in column B for a word. However, the cell will have multiple words in it, but I only want to look for one (so regularly I would use the INSTR function).

Then, if the word is found within the cell, I need to copy the whole row to another sheet. If it doesn't exist, exit sub for all I care.

So far I have (but it doesn't work):

Sub Contain_Copy()
Dim ranger As Long
Dim lastrow As Long
lastrow = Range("B3741").End(xlUp).Row

Sheets("Extract").Select
For ranger = 2 To lastrow

If InStr(1, Range("B" & ranger), "SWR", vbTextCompare) Then Range("B" & ranger).EntireRow.Copy _
Destination:=Sheets("Sheet6").Range("A1").End(xlUp).Offset(1, 0)

Next ranger
End Sub


Could someone pleeeease take a look at this and help me out before I go mad?

 

[RoryA]

Your destination is wrong:

Sub Contain_Copy()
Dim ranger As Long
Dim lastrow As Long
lastrow = Range("B3741").End(xlUp).Row

Sheets("Extract").Select
For ranger = 2 To lastrow

If InStr(1, Range("B" & ranger), "SWR", vbTextCompare) Then Range("B" & ranger).EntireRow.Copy _
Destination:=Sheets("Sheet6").Cells(rows.count, "A").End(xlUp).Offset(1, 0)

Next ranger
End Sub

You could also use the Find method in a loop.

 

[chemEE]

The destination for the copy? Do I have a mismatch or an omission? Is the general logic right in this?

 

[RoryA]

The general logic is correct - see my amended version. You were finding the destination by going up from A1 and then offsetting by one, so you just overwrite the same cell every time.

 

[Jonmo1]

In addition to rorya's comments...

I assume you want to copy FROM the sheet named Extract, and paste TO the sheet named Sheet6
But you are defining your lastrow variable PRIOR to the Extract sheet being selected.
So it may be getting an incorrect value, based on whatever sheet is active when you run the code.

Best bet is to not select the sheet to begin with, and explicitly name the sheet in the copy command...

Try

Sub Contain_Copy()
Dim ranger As Long
Dim lastrow As Long
Dim FromSheet As Worksheet, ToSheet As Worksheet
 
Set FromSheet = Sheets("Extract")
Set ToSheet = Sheets("Sheet6")
lastrow = FromSheet.Cells(Rows.Count, "B").End(xlUp).Row
 
For ranger = 2 To lastrow
    If InStr(1, FromSheet.Cells(ranger, "B"), "SWR", vbTextCompare) > 0 Then
        FromSheet.Cells(ranger, "B").EntireRow.Copy _
        Destination:=ToSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    End If
Next ranger
End Sub

 

[chemEE]

Guys, you are the greatest. Thank you so so much. I am extraordinarily grateful for your help!

 

[waryahjee]

Copying Entire Sheets to another Sheet

Hi Good morning Guys,

I am new with the VAB code i need your help with my issue.
I am having 9 to 10 differnet excel sheets and all having different numbers of rows which one i want to copy on one sheets but i want to bulit some thing dynamic that if the business change the date on sheets the main sheet should be updated and also can carry the condiational formating with the copy paste.

Sub Contain_Copy()
Dim ranger As Long
Dim lastrow As Long
Dim FromSheet As Worksheet, ToSheet As Worksheet

Set FromSheet = Sheets("Extract")
Set ToSheet = Sheets("Sheet6")
lastrow = FromSheet.Cells(Rows.Count, "B").End(xlUp).Row

For ranger = 2 To lastrow
If InStr(1, FromSheet.Cells(ranger, "B"), "SWR", vbTextCompare) > 0 Then
FromSheet.Cells(ranger, "B").EntireRow.Copy _
Destination:=ToSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next ranger
End Sub

I coped this code and i not sure where i am goin use this one.

Many Many thanks


J Waryah.

 

[RoryA]

Re: Copying Entire Sheets to another Sheet

This doesn't appear to relate to the question so I suggest you start a new question please.