Autofilter on Mutliple Columns Excel VBA - 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