Autofilter on Mutliple Columns Excel VBA

Question

I need to filter a data table where 3 columns can contain the result I am looking for:

So if the criteria is found in columns 1, 2 or 3 then the row should be returned.

_{(source: gulfup.com)}

So in the above sample data lets say I select the criteria as "Fat"

I am looking for the autofilter to return rows 1 & 2; if I select the criteria as "Funny" I need rows 2 & 6 and so on....

Below is my code which is not working since apparently it tries to find the rows in which all columns contain the criteria, and it is not what I am looking to do.

With Sheet1
    .AutoFilterMode = False

    With .Range("A1:D6")
    .AutoFilter
    .AutoFilter Field:=2, Criteria1:="Fat", Operator:=xlFilterValues
    .AutoFilter Field:=3, Criteria1:="Fat", Operator:=xlFilterValues
    .AutoFilter Field:=4, Criteria1:="Fat", Operator:=xlFilterValues
    End With
End With

I have also tried to use Operator:=xlor but when I ran the code it returned no results.

In short: The row must be returned by the filter is the criteria is found in column B or C or D.

Help is definitely appreciated.

Answer 1

As follow up from comments, there are two ways for you.

Use additional column with formula:

Dim copyFrom As Range

With Sheet1
    .AutoFilterMode = False

    With .Range("A1:E6")
        'apply formula in column E
        .Columns(.Columns.Count).Formula = "=OR(B1=""Fat"",C1=""Fat"",D1=""Fat"")"
        .AutoFilter Field:=5, Criteria1:=True

        On Error Resume Next
        Set copyFrom = .Offset(1).Resize(.Rows.count - 1).SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
    End With
End With

If Not copyFrom Is Nothing Then copyFrom.EntireRow.Copy

Use For loop with Union:

Dim copyFrom As Range
Dim i As Long

With Sheet1
    For i = 2 To 6
        If .Range("B" & i) = "Fat" Or .Range("C" & i) = "Fat" Or .Range("D" & i) = "Fat" Then
            If copyFrom Is Nothing Then
                Set copyFrom = .Range("B" & i)
            Else
                Set copyFrom = Union(.Range("B" & i), copyFrom)
            End If
        End If
    Next
End With

If Not copyFrom Is Nothing Then copyFrom.EntireRow.Copy

For copying also header:

Dim copyFrom As Range
Dim i As Long

With Sheet1
    Set copyFrom = .Range("B1")
    For i = 2 To 6
        If .Range("B" & i) = "Fat" Or .Range("C" & i) = "Fat" Or .Range("D" & i) = "Fat" Then
            Set copyFrom = Union(.Range("B" & i), copyFrom)
        End If
    Next
End With

copyFrom.EntireRow.Copy

---

---

UPDATE:

Dim hideRng As Range, copyRng As Range
Dim i As Long
Dim lastrow As Long

With Sheet1
    lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
    .Cells.EntireRow.Hidden = False
    For i = 2 To lastrow
        If Not (.Range("B" & i) = "Fat" Or .Range("C" & i) = "Fat" Or .Range("D" & i) = "Fat") Then
            If hideRng Is Nothing Then
                Set hideRng = .Range("B" & i)
            Else
                Set hideRng = Union(.Range("B" & i), hideRng)
            End If
        End If
    Next
    If Not hideRng Is Nothing Then hideRng.EntireRow.Hidden = True

    On Error Resume Next
    Set copyRng = .Range("B1:B" & lastrow).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
End With

If copyRng Is Nothing Then
    MsgBox "There is no rows matching criteria - nothing to copy"
    Exit Sub
Else
    copyRng.EntireRow.Copy
End If