Copy row IF cell contains specific word

[mvreeswijk]

Dear all,

I have a problem concerning the following: I have an Excel file containing 20 colums and 12000 rows. I would like to filter the data based on certain words. As an example, IF column 3, 4, 5 or 6 contains the word "Bank" it should select the entire row and copy the contents of the entire row into a new sheet.

It should thus go through all 12.000 rows and when it finds the word "bank" e.g. "bank of indonesia" or "the royal bank" it should copy everything in that row and copy it in e.g. a new worksheet named "internal".

Can anyone help me on this?

Thanks in advance.

Mark Vreeswijk

 

[Bassmoore]

Hi,

This works great!! Is it possible to change it to open more than 1 file and copy the rows into a completely different file?

I have over 100 different spreadsheets and i dont want to open them up individually and run this!

Thanks in advance..

 

[adel3001]

My solution does not need you to write a code. Just by Highlighting and Filtering and its super easy

I explain by an example : If the word of "Total" is in several rows ( say, we have the term of " Total" in rows 5,10,12.... and we have say 60000 row that makes it difficult to copy and paste one by one).

1-Select all columns and rows/Home/Conditional Formatting/Highlight cells roles/text that contains/ type (in this example “Total”)
Now all the rows contain the term “Total” are highlighted by a color

2- Data/Filter/ Click on the triangle of filter of the column which contains all the rows contain that term ( in my example, below the column A are all 60000 rows that some of them contain “ Total”/Filter by Color/ select the color

Now you have only the rows contain “Total” and you have gotten rid of other rows.

 

[Pugsrcool]

In fact try this

Sub BankMove()
Dim strArray As Variant
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim NoRows As Long
Dim DestNoRows As Long
Dim I As Long
Dim J As Integer
Dim rngCells As Range
Dim rngFind As Range
Dim Found As Boolean
    
    strArray = Array("bank", "KLM", "firm")
    
    Set wsSource = ActiveSheet
    
    NoRows = wsSource.Range("A65536").End(xlUp).Row
    DestNoRows = 1
    Set wsDest = ActiveWorkbook.Worksheets.Add
        
    For I = 1 To NoRows
    
        Set rngCells = wsSource.Range("C" & I & ":F" & I)
        Found = False
        For J = 0 To UBound(strArray)
            Found = Found Or Not (rngCells.Find(strArray(J)) Is Nothing)
        Next J
        
        If Found Then
            rngCells.EntireRow.Copy wsDest.Range("A" & DestNoRows)
            
            DestNoRows = DestNoRows + 1
        End If
    Next I
End Sub

It will copy any row that contains any of the words in strArray.

---------
I really this and am trying to get it to work for something I am working on as well.. however my data is in column A-M and I want to paste the matching results in column N-O
My data is a maximum of 600 rows .. not sure if that matters.

 

[Expeditor]

Hi. I have a similar problem.
I currently have 8 spreadsheets within a workbook. I wish to search all column A's from every spreadsheet for a specific term or name, let's say 'John', then produce a new spreadsheet (called 'John') containing all of those rows data within spreadsheets 1-8.
So if he had row 2,5,7 from spreadsheet 1, row 4,8,12 from spreadsheet 3, row 5 from spreadsheet 6, etc.
I would then like to repeat this for 'Dave' & 'Sally' etc. Each time creating a new spreadsheet for each individual search term.
Basically spreadsheets 1-8 are product based, then I wish to create a 'Salesperson' based spreadsheet from that data.

 

[whassan]

Dear All,

This is my first post on this website and have little knowledge about <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-bottom-style: dotted; border-bottom-color: rgb(0, 0, 0); cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">VBA</acronym> macros
Below is my query if anyone provide solution please

I have four excel sheets

CP maturity
CD maturity
CP settlement
CD settlement

On these four sheets data extracts from four different sheets via formulas and fills information in appropriate cells. Data I get via formulas is in different currencies e.g. GBP, USD, EUR

I need macro to select one sheet at time and copy all the lines which has EUR and paste these lines in another sheet (BLANK) in same workbook on C9 cells and so on and skip line which already have text/data.

And likewise, copy USD and GBP lines from four sheets (names mentioned above) and paste in BLANK sheet (sheet name).

At the moment I select entries based on CCY and paste them in BLANK sheet manually and print sheet and then delete data and copy next CCY lines and paste and print sheet and delete and so on.

I need three Active X controls buttons for GBP, EUR and USD so it will work like when I press GBP, <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-bottom-style: dotted; border-bottom-color: rgb(0, 0, 0); cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">VBA</acronym> macro select all lines from the four sheets (name mentioned above) which have GBP and paste on BLANK sheet (on BLANK sheet need to paste from cell C9 on next available empty row.

I will really appreciate if someone please provide <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-bottom-style: dotted; border-bottom-color: rgb(0, 0, 0); cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">VBA</acronym> macro solution for this.


Many thanks,

 

[Fahad88]

I used the above code, (thanks Norie !!) and tweaked a bit to suit my requirements, but the values i have in column 'f' are a result of a vlookup formula, and it does'nt seem to work with it. !!

If the cell has plain text, it works fine, but when the value of the cell resulted due to formula it doesnt. Any help is appreciated.

the code is provided below..

Sub Report()
Dim strArray As Variant
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim NoRows As Long
Dim DestNoRows As Long
Dim I As Long
Dim J As Integer
Dim rngCells As Range
Dim rngFind As Range
Dim Found As Boolean

strArray = Array("XYZ")

Set wsSource = ActiveSheet

NoRows = wsSource.Range("A65536").End(xlUp).Row
DestNoRows = 8
Set wsDest = Sheets("Franchise")

For I = 1 To NoRows

Set rngCells = wsSource.Range("F" & I)
Found = False
For J = 0 To UBound(strArray)
Found = Found Or Not (rngCells.Find(strArray(J)) Is Nothing)
Next J

If Found Then
rngCells.EntireRow.Copy wsDest.Range("A" & DestNoRows)

DestNoRows = DestNoRows + 1
End If
Next I
End Sub