Public Function GetFilteredValues(colHeader As Range, criteria As Variant, Optional ByVal colOffset As Long = 0) As Variant
With colHeader.Worksheet
If .FilterMode Then .ShowAllData
End With
If IsArray(criteria) Then
Dim i As Long, isPresent As Boolean
For i = LBound(criteria) To UBound(criteria)
isPresent = isPresent Or _
Not (Range(colHeader.Offset(1, 0), colHeader.End(xlDown)).Find(criteria(i), LookIn:=xlValues, LookAt:=xlPart) Is Nothing)
Next i
If Not isPresent Then
GetFilteredValues = Array("")
Exit Function
End If
Else
If Range(colHeader.Offset(1, 0), colHeader.End(xlDown)).Find(criteria, LookIn:=xlValues, LookAt:=xlPart) Is Nothing Then
GetFilteredValues = Array("")
Exit Function
End If
End If
If IsArray(criteria) Then
colHeader.AutoFilter Field:=1, Criteria1:=criteria, Operator:=xlFilterValues
Else
colHeader.AutoFilter Field:=1, Criteria1:=criteria
End If
Dim filRng As Range
Set filRng = Range( _
colHeader.Offset(1, 0), _
colHeader.End(xlDown) _
).SpecialCells(xlCellTypeVisible).Offset(0, colOffset)
Dim data() As Variant, cellI As Range
ReDim data(1 To filRng.Cells.Count, 1 To 1)
i = 1
For Each cellI In filRng
data(i, 1) = cellI.Value2
i = i + 1
Next cellI
colHeader.AutoFilter
GetFilteredValues = data
End Function
Sub TestFilter()
Dim fil1 As Variant
fil1 = GetFilteredValues(Sheet2.Range("A1"), 3)
If UBound(fil1, 1) > 0 Then
Sheet1.Range("A2").Resize(UBound(fil1, 1), 1).Value2 = fil1
End If
fil1 = GetFilteredValues(Sheet2.Range("A1"), Array("3", "A"))
If UBound(fil1, 1) > 0 Then
Sheet1.Range("B2").Resize(UBound(fil1, 1), 1).Value2 = fil1
End If
fil1 = GetFilteredValues(Sheet2.Range("A1"), Array("G", "H"))
If UBound(fil1, 1) > 0 Then
Sheet1.Range("C2").Resize(UBound(fil1, 1), 1).Value2 = fil1
End If
fil1 = GetFilteredValues(Sheet3.Range("B1"), Array("I", "G", "H", "5"), 1)
If UBound(fil1, 1) > 0 Then
Sheet1.Range("D2").Resize(UBound(fil1, 1), 1).Value2 = fil1
End If
fil1 = GetFilteredValues(Sheet3.Range("B1"), "*I*")
If UBound(fil1, 1) > 0 Then
Sheet1.Range("E2").Resize(UBound(fil1, 1), 1).Value2 = fil1
End If
End Sub