VBA: Filter that contains with multiple criteria

[unknownymous]

Hi Gurus,

I have below sample raw data. I need to filter and move the information that contains certain words. Example I need to Copy the whole row that contains "Missed", "Chck", "Note"& "Check" (might add more) in the Subject Column.

Account	Subject	Number	x	Note 1	Note 2	Note 3
001	Math - Missed	95
002	Science	90
003	History (Chck)	85
004	Language Arts with Note	80
005	Foreign Language	75
006	Others Check	70

Example: Another tab will be created for below Output

Account	Subject	Number	x	Note 1	Note 2	Note 3
001	Math - Missed	90
003	History (Chck)	85
004	Language Arts with Note	80
006	Others Check	70

Do you have any idea on how to code this or if this is feasible? Any help will be much appreciated.

 

[Trevor G]

Check Norie's thread, change the search names and it will do what you need it to do. You only then need to add to format the column width and row height

Copy row IF cell contains specific word

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...

www.mrexcel.com

Adjust this part of the code

strArray = Array("bank", "KLM", "firm")

To

'What to check for within the cells
    strArray = Array("Chck", "Note", "Check", "Missed")

Add this extra code after the Next I to adjust the column width and row height

With Cells
    .ColumnWidth = 58.29
    .RowHeight = 60.75
    .EntireRow.AutoFit
    .EntireColumn.AutoFit
    End With

 

[Yongle]

or try this
amend "Name of Sheet" = name of the sheet containing original data

Sub CopyValues()
    Dim ws1 As Worksheet, ws2 As Worksheet, lr As Long, r As Long, lookFor As String
    Dim a As Long, arr As Variant, wf As WorksheetFunction
  
    Set wf = WorksheetFunction
    Set ws1 = Sheets("Name of Sheet")
    lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row
'get words
    lookFor = "missed chck note"
    lookFor = wf.Trim(InputBox("words separated by space", "Search for what?", lookFor))

    If lookFor <> "" Then
        arr = Split(lookFor)
'create new sheet based on old sheet
        ws1.Copy before:=Sheets(1)
        Set ws2 = Sheets(1)
        ws2.UsedRange.Offset(1).Clear
'add required rows
        For r = 2 To lr
            For a = 0 To UBound(arr)
                If wf.CountIf(ws1.Cells(r, 2), "*" & arr(a) & "*") > 0 Then
                    ws1.Rows(r).Copy ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
                    Exit For
                End If
            Next a
        Next r
    End If
End Sub