Alternative of FILTER function on non office 365

Question

Using a Macro or Formula, is there a way to achieve the result of the following formula of Office 365?

=FILTER(B:B,A:A = "x")

What it does is get all the values from Column B if Column A on the same row has a value of x.

My PC has office 365 but the one I'm working with only has Office Pro Plus 2019. I had to use my pc when I needed the function and I'm getting tired of it, maybe it can be done on Office Pro Plus 2019 too using a formula or a macro?

Answer 1

=FILTER(B:B,A:A = "x")

Alternative:

Assuming your data is in Sheet1. Create new sheet. Into cell A1 place:

=INDEX(Sheet1!A:A,B1,0))

Automatically fill down column A with this formula. Then into cell B1 place:

=MATCH("x",Sheet1!B:B, 0)

Then into cell B2 place:

 =MATCH("x",INDIRECT("Sheet1!B" & B1+1 & ":B"), 0) + B1

Then fill down column B with formula starting from B2.

Thus in column B you will have the indexes of your filtered data from Sheet1. And column A will actually contain the filtered data.

If you need to filter multiple (non-adjacent) columns, you can use CHOOSE:

=INDEX(CHOOSE({1,2,3},Sheet1!A:A,Sheet1!H:H,Sheet1!D:D),B1,0)

Answer 2

You might try the following udf (example call: FILTER2(A1:A100,B1:B100)) consisting of the following tricky steps:

• a) Evaluate the general condition (=If(A1:A100="x",Row(A1:A100),"?") as tabular Excel formula and assign all valid row numbers to array x (marking the rest by "?" strings),
• b) Filter out all "?" elements
• c) Apply x upon the data column benefitting from the advanced restructuring features of Application.Index()

Public Function Filter2(rng1 As Range, rng2 As Variant, Optional ByVal FilterID As String = "x")
    Dim a As String: a = rng1.Address(False, False, External:=True)
    'a) get all valid row numbers (rng1)
    Dim myformula As String: myformula = "if(" & a & "=""" & FilterID & """,row(" & a & "),""?"")"
    Dim x: x = Application.Transpose(Evaluate(myformula))
    'b) filter out invalid "?" elements
    x = VBA.Filter(x, "?", False)
    'c) apply x upon data column (rng2)
    If UBound(x) > -1 Then Filter2 = Application.Index(rng2, Application.Transpose(x), 1)
End Function

Note that function calls before versions 2019/MS 365 need to be entered as array formula (Ctrl+Shift+Enter).

The function assumes one-column (range) arguments.

---

Edit due to comment as of 2022-06-08

The whole example is based on the actual row numbers starting in the first row (OP ranges refer to A:A,B:B. If you want to allow ranges to start at any row, you'd need to change the myFormula definition in section a) by correcting the row indices by subtracting possible offsets (row number + 1 - first row):

    Dim myFormula As String
    myFormula = "if(" & a & "=""" & FilterID & """,row(" & a & ")+1 -" & rng1.Row & ",""?"")"

Answer 3

I had some spare time and I am recently interested in User defined functions so I decided to make my own version of what I imagine this would be. I'm prefacing this by saying its not good and is excessively long but it works!

Function JOINIF(ByRef IfRange As Range, ByVal Criteria As String, Optional JoinRange As Range, Optional Delimeter As String = ",") As String
    'IfRange is the range that will be evaluated by the Criteria
    
    'Criteria is a logical test that can be applied to a cell value.
    'Examples of Criteria: "=Steve", ">100", "<>Toronto", "<=-1"
    
    'JoinRange is the range of values that will be concatenated if the corresponding -
    'IfRange cell meets the criteria. JoinRange can be left blank if the values to be -
    'concatenated are the IfRange values.
    
    'Delimeter is the string that will seperate the concatenated values.
    'Default delimeter is a comma.
    
    Dim IfArr() As Variant, JoinArr() As Variant, OutputArr() As String
    Dim IfArrDim As Integer, JoinArrDim As Integer
    Dim JCount As Long, LoopEnd(1 To 2) As Long
    Dim MeetsCriteria As Boolean, Expression As String
    Dim i As Long, j As Long
    
'PARSING THE CRITERIA
    Dim Regex As Object
    Set Regex = CreateObject("VBScript.RegExp")
    Regex.Pattern = "[=<>]+"
    'Looking for comparison operators
    Dim Matches As Object
    Set Matches = Regex.Execute(Criteria)
    If Matches.Count = 0 Then
        'If no operators found, assume default "Equal to"
        If Not IsNumeric(Criteria) Then
            'Add quotation marks to allow string comparisons
            Criteria = "=""" & Criteria & """"
        End If
    Else
        If Not IsNumeric(Replace(Criteria, Matches(0), "")) Then
            Criteria = Matches(0) & """" & Replace(Criteria, Matches(0), "") & """"
        End If
        'Add quotation marks to allow string comparisons
    End If
    
    'Trim IfRange to UsedRange
    Set IfRange = Intersect(IfRange, IfRange.Parent.UsedRange)
    
    'Default option for optional JoinRange input
    If JoinRange Is Nothing Then
        Set JoinRange = IfRange
    Else
        Set JoinRange = Intersect(JoinRange, JoinRange.Parent.UsedRange)
    End If
    
'DIMENSIONS
    'Filling the arrays
    If IfRange.Cells.Count > 1 Then
        IfArr = IfRange.Value
        IfArrDim = Dimensions(IfArr)
    Else
        ReDim IfArr(1 To 1)
        IfArr(1) = IfRange.Value
        IfArrDim = 1
    End If
    If JoinRange.Cells.Count > 1 Then
        JoinArr = JoinRange.Value
        JoinArrDim = Dimensions(JoinArr)
    Else
        ReDim JoinArr(1 To 1)
        JoinArr(1) = JoinRange.Value
        JoinArrDim = 1
    End If
    
    'Initialize the Output array to the smaller of the two input arrays.
    ReDim OutputArr(IIf(IfRange.Cells.Count < JoinRange.Cells.Count, IfRange.Cells.Count - 1, JoinRange.Cells.Count - 1))
    
'DEFINING THE LOOP PARAMETERS
    'Loop ends on the smaller of the two arrays
    If UBound(IfArr) > UBound(JoinArr) Then
        LoopEnd(1) = UBound(JoinArr)
    Else
        LoopEnd(1) = UBound(IfArr)
    End If
    If IfArrDim = 2 Or JoinArrDim = 2 Then
        If Not (IfArrDim = 2 And JoinArrDim = 2) Then
            'mismatched dimensions
            LoopEnd(2) = 1
        ElseIf UBound(IfArr, 2) > UBound(JoinArr, 2) Then
            LoopEnd(2) = UBound(JoinArr, 2)
        Else
            LoopEnd(2) = UBound(IfArr, 2)
        End If
    End If
    
'START LOOP
    If IfArrDim = 1 Then
        For i = 1 To LoopEnd(1)
            If IsNumeric(IfArr(i)) And IfArr(i) <> "" Then
                Expression = IfArr(i) & Criteria
            Else
                'Add quotation marks to allow string comparisons
                Expression = """" & IfArr(i) & """" & Criteria
            End If
            
            MeetsCriteria = Application.Evaluate(Expression)
            
            If MeetsCriteria Then
                If JoinArrDim = 1 Then
                    OutputArr(JCount) = CStr(JoinArr(i))
                Else
                    OutputArr(JCount) = CStr(JoinArr(i, 1))
                End If
                JCount = JCount + 1
            End If
        Next i
    Else
        For i = 1 To LoopEnd(1)
            For j = 1 To LoopEnd(2)
                If IsNumeric(IfArr(i, j)) And IfArr(i, j) <> "" Then
                    Expression = IfArr(i, j) & Criteria
                Else
                    'Add quotation marks to allow string comparisons
                    Expression = """" & IfArr(i, j) & """" & Criteria
                End If
                
                MeetsCriteria = Application.Evaluate(Expression)
                
                If MeetsCriteria Then
                    If JoinArrDim = 1 Then
                        OutputArr(JCount) = CStr(JoinArr(i))
                    Else
                        OutputArr(JCount) = CStr(JoinArr(i, j))
                    End If
                    JCount = JCount + 1
                End If
            Next j
        Next i
    End If

'END LOOP
    ReDim Preserve OutputArr(JCount + 1 * (JCount > 0))
    JOINIF = Join(OutputArr, Delimeter)
End Function
Private Function Dimensions(var As Variant) As Long
    'Credit goes to the great Chip Pearson, chip@cpearson.com, www.cpearson.com
    On Error GoTo Err
    Dim i As Long, tmp As Long
    While True
        i = i + 1
        tmp = UBound(var, i)
    Wend
Err:
    Dimensions = i - 1
End Function

Examples of it in use:

Seperate IfRange and JoinRange

IfRange as the JoinRange

Answer 4

Try this UDF for the Filter Function:

Function FILTER_HA(Where, Criteria, Optional If_Empty) As Variant
  Dim Data, Result
  Dim i As Long, j As Long, k As Long
  'Create space for the output (same size as input cells)
  With Application.Caller
    i = .Rows.Count
    j = .Columns.Count
  End With
  'Clear
  ReDim Result(1 To i, 1 To j)
  For i = 1 To UBound(Result)
    For j = 1 To UBound(Result, 2)
      Result(i, j) = ""
    Next
  Next
  'Count the rows to show
  For i = 1 To UBound(Criteria)
    If Criteria(i, 1) Then j = j + 1
  Next
  'Empty?
  If j < 1 Then
    If IsMissing(If_Empty) Then
      Result(1, 1) = CVErr(xlErrNull)
    Else
      Result(1, 1) = If_Empty
    End If
    GoTo ExitPoint
  End If
  'Get all data
  Data = Where.Value
  'Copy the rows to show
  For i = 1 To UBound(Data)
    If Criteria(i, 1) Then
      k = k + 1
      For j = 1 To UBound(Data, 2)
        Result(k, j) = Data(i, j)
      Next
    End If
  Next
  'Return the result
ExitPoint:
  FILTER_HA = Result
End Function

Answer 5

Use:

=IFERROR(INDEX($B$1:$B$100,AGGREGATE(15,7,ROW($A$1:$A$100)/($A$1:$A$100="x"),ROW($ZZ1))),"")

Note the use of a set range and not full columns. That is done on purpose, This being an array formula it will do a lot of calculations each cell it is placed. Limiting the range to the data set will speed it up.

Put this in the first cell of the output and copy down till blanks are returned.