Search cell content for particular word, if found copy row

[spectraflame]

I have imported a text file into Excel. Column B contains a text string that varies in lengh from blank up to 50 characters. I need to be able to search the values in that column and copy the entire row to another sheet within the same workbook if the cell contains the word REMOTE.

Is this possible?

Thanks,
Matthew

 

[Scott Huish]

Re: Search cell content for particular word, if found copy r

Try this:
This macro will look for the word "REMOTE" in each cell of Column B on Sheet1 and if it is there will then write the entire row into Sheet2 starting at A1.

Sub moveremote()
Dim x As Long, y As Long
y = 1
Application.ScreenUpdating = False
For x = 1 To Worksheets("Sheet1").Range("B65536").End(xlUp).Row
If InStr(1, Worksheets("Sheet1").Range("B" & x), "REMOTE") > 0 Then
Worksheets("Sheet1").Range("B" & x).EntireRow.Copy
Worksheets("Sheet2").Range("A" & y).PasteSpecial
Application.CutCopyMode = False
y = y + 1
End If
Next x
Application.ScreenUpdating = True
End Sub

 

[spectraflame]

Re: Search cell content for particular word, if found copy r

Thanks HOTPEPPER!

That works just like I needed it to.

Matthew

 

[compressor]

Sorry to intrude but
I have a need for something like this.

How would I modify it to use Column A and then delete the entire row
from Sheet1 after the text string is found and pasted in Sheet 2?

Thanks.

compressor

 

[Nimrod]

How would I modify it to use Column A and then delete the entire row
from Sheet1 after the text string is found and pasted in Sheet 2?

ASSUMPTIONS:
- sheet to copy from is active
- criterial column is column B
- Header row has values AND is row 1:1

FEATURES
- This solution has no loops to slow process down

Public Sub DEMO()
Dim Src As String
Src = ActiveSheet.Name

    'MAKE COPY OF ALL ROWS WITH "REMOTE" IN COL B
    CopyByCriteria ("REMOTE")
    
    Sheets(Src).Activate
    
    'MAKE COPY OF ALL ROWS WITH "REMOTE" NOT IN COL B
    DeleteByCriteria ("REMOTE")
    
End Sub


Sub CopyByCriteria(Crit)
Dim SrcRange As Range
Dim CritRange As Range

Set SrcRange = Range("A1:Z65536")
Set CritRange = Range("IV1:IV2")

'Establish Criteria
    CritRange(1).ClearContents
    CritRange(2).Formula = "=FIND(" & Chr(34) & Crit & Chr(34) & ",B2,1)>0"
  
'Create Target Sheet
    Sheets.Add

'Use Advanced Filter to copy data that meets criteria
    SrcRange.AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=CritRange, _
    CopyToRange:=Range("A1"), Unique:=False
    
' Clear Criteria
   CritRange.ClearContents
End Sub


Sub DeleteByCriteria(Crit)
Dim SrcRange As Range
Dim CritRange As Range

Set SrcRange = Range("A1:Z65536")
Set CritRange = Range("IV1:IV2")

'Establish Criteria
    CritRange(1).ClearContents
    CritRange(2).Formula = "=iserror(FIND(" & Chr(34) & Crit & Chr(34) & ",B2,1)>0)"
  
'Create Target Sheet
    Sheets.Add

'Use Advanced Filter to copy data that meets criteria
    SrcRange.AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=CritRange, _
    CopyToRange:=Range("A1"), Unique:=False
    
' Clear Criteria
   CritRange.ClearContents
End Sub

 

[Nimrod]

VERSION 2

FEATURES
- This solution has no loops to slow process down



Sub DEMO2()
Dim Src As String
Src = ActiveSheet.Name

'MAKE COPY OF ALL ROWS WITH "REMOTE" IN COL B
CopyByCriteria ("=FIND(""REMOTE"",B2,1)>0")

Sheets(Src).Activate

'MAKE COPY OF ALL ROWS WITH "REMOTE" <NOT> IN COL B
CopyByCriteria ("=iserror(FIND(""REMOTE"",B2,1)>0)")

End Sub


Sub CopyByCriteria(Crit)
Dim SrcRange As Range
Dim CritRange As Range

Set SrcRange = Range("A1:Z65536")
Set CritRange = Range("IV1:IV2")

'Establish Criteria
CritRange(1).ClearContents
CritRange(2).Formula = Crit

'Create Target Sheet
Sheets.Add

'Use Advanced Filter to copy data that meets criteria
SrcRange.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=CritRange, _
CopyToRange:=Range("A1"), Unique:=False

' Clear Criteria
CritRange.ClearContents
End Sub

 

[compressor]

Thanks Nimrod! Both seem to work.
But the macro puts the resulting Sheets before Sheet1.

Not a big deal but can it keep the Sheets in order?

What do I change to make it look at Column A of Sheet1?

Now if I may take this a step further.

Ideally I would like to search for multiple text strings
in Column A, put each on a seperate sheet, delete from the original,
and be able to add more text strings to the search
as needed in the future.
The starting file will be one sheet with less than 10000 rows and upto
20 columns. The search would always be based on Column A text strings.

Could you help with this?

compressor

 

[Nimrod]

Not a big deal but can it keep the Sheets in order?

Public Sub NewSheetAfterCurrSh()
    ' new sheet behind current sheet
    Sheets.Add after:=ActiveSheet
End Sub

Public Sub NewSheetAtVeryEnd()
    ' new sheet behind all sheets
    Sheets.Add after:=Sheets(Sheets.Count)
End Sub

 

[Nimrod]

What do I change to make it look at Column A of Sheet1?

If your using VERSION 2 then just change it to this ...

Sub DEMO2()
Dim Src As String

Src = "Sheet1"
Sheets(Src).Activate


'MAKE COPY OF ALL ROWS WITH "REMOTE" IN COL B
CopyByCriteria ("=FIND(""REMOTE"",A2,1)>0")

Sheets(Src).Activate

'MAKE COPY OF ALL ROWS WITH "REMOTE" IN COL B
CopyByCriteria ("=iserror(FIND(""REMOTE"",A2,1)>0)")

End Sub

NOTE:
- change 1 was the addition of what sheet to select
- change 2 was the B2 , in the criteria, was change to A2

 

[Nimrod]

Ideally I would like to search for multiple text strings
in Column A, put each on a seperate sheet, delete from the original,
and be able to add more text strings to the search
as needed in the future.
The starting file will be one sheet with less than 10000 rows and upto
20 columns. The search would always be based on Column A text strings.

CONFIG :
This line is what you modify for you various search strings:
For Each SrchString In Array("REMOTE", "TOM", "****", "HARRY")

Assumptions
- Source Sheet is active
- Criterial Column is Column A

Sub DEMO3()
Dim Src As String
Src = ActiveSheet.Name

For Each SrchString In Array("REMOTE", "TOM", "****", "HARRY")
    

    'MAKE COPY OF ALL ROWS WITH STRING IN COL B
    CopyByCriteria ("=FIND(" & Chr(34) & SrchString & Chr(34) & ",A2,1)>0")
    
    Sheets(Src).Activate
    
    'MAKE COPY OF ALL ROWS WITH "REMOTE" IN COL B
    CopyByCriteria ("=iserror(FIND(" & Chr(34) & SrchString & Chr(34) & ",A2,1)>0)")
    
    'MAKE NEW COPY THE SOURCE SHEET
    Application.DisplayAlerts = False
    Sheets(Src).Delete
    ActiveSheet.Name = Src
    Application.DisplayAlerts = True
    
Next SrchString

End Sub


Sub CopyByCriteria(Crit)
Dim SrcRange As Range
Dim CritRange As Range

    Set SrcRange = Range("A1:Z65536")
    Set CritRange = Range("IV1:IV2")
    
    'Establish Criteria
    CritRange(1).ClearContents
    CritRange(2).Formula = Crit
    
    'Create Target Sheet
    Sheets.Add after:=ActiveSheet
    
    'Use Advanced Filter to copy data that meets criteria
    SrcRange.AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=CritRange, _
    CopyToRange:=Range("A1"), Unique:=False
    
    ' Clear Criteria
    CritRange.ClearContents
End Sub