Search code examples
arraysexcelvbafiltercriteria

Non-contiguous array as filter criteria for xlfiltervalues

Common problem, I have worked through all answers I've found and finally got it almost working.

I have a list of discount options, let's call them named range F, down 1 column. User filters out the discounts they don't want to apply. I need to unfilter, do work, and refilter as the user selected.

I create an array with only visible cells, by loop and union of ranges. This works correctly, but generates a non-contiguous array usually.

When I run this, I don't get an error. However, the entry below the break in the contiguous array is not refiltered.

Just realised it's the transpose that doesn't like non-contiguous arrays - still need assistance and doubtless others have same issue so leaving as is

What's the easiest, most painless (it's nearly Friday), way to persuade Criteria1 to include the last elements in my non-contiguous array?

Sub Filters()

'Dimension variables
Dim Rng As Range
Dim i, Lim As Integer
Dim w As Worksheet
Dim Op As Variant

Set w = ActiveSheet

'Set Lim as total number of rows in named range "F" (only 1 cell in use but same effect)
Lim = Range("F").Rows.Count

'Data has header row so skip to row 2
i = 2

'Loop through i up to limit
Do While i <= Lim
    'If the row is not hidden by the filters the user chose

    If Range("F")(i, 1).EntireRow.Hidden = False Then
        'Check if the range is nothing - if it is, union will not work to itself
        'Union requires non-empty arguments

        If Rng Is Nothing Then
            'Set the Rng to include the current cell from "F"
            Set Rng = Range("F")(i, 1)

        Else
            'If Rng has some value, add the current cell to it by Union
            Set Rng = Application.Union(Rng, Range("F")(i, 1))

        End If

    End If

    'Increment i
    i = i + 1

    Loop

    If w.AutoFilter.Filters.Item(1).Operator <> False Then Op = w.AutoFilter.Filters.Item(1).Operator

    'This gives the correct range, but most often non-contiguous
    MsgBox Range("F").Address

    'Remove AutoFilter
    w.AutoFilterMode = False




    'Insert Code Here




    'Put filters back

    'Check for Rng being non-empty (pointless running code if it is)
    If Not IsEmpty(Rng) Then
        'If there is an operator then use the array
        If Op Then
            'Found this option useful here - can transpose the array values which generates an array Criteria1 can use
            'Always xlFilterValues as there will always be more than 2 options
            'Also the options are taken from the worksheet live so won't change between times so specifying them precisely as strings is ok
            Range("F").AutoFilter Field:=1, Criteria1:=Application.Transpose(Rng.Value), _
            Operator:=xlFilterValues
        Else
            'Just filter the range but leave all options available
            Range("F").AutoFilter Field:=1
        End If
    End If

End Sub
Solution

  • Answered by using a second counter to count successful entries that should be included as criteria, and writing them to a range in another worksheet. Then set the range to be that new (contiguous) range in the new worksheet.

    Now works like a charm at last. Only took me all day to find syntax that worked with Criteria, and figure that you can only use xlOr for up to 2 criteria, otherwise it's xlfiltervalues...

    Final working code as generic as I can get it to be as helpful as possible:

    Sub Filters()

'Dimension variables
Dim Rng As Range
Dim i, j, Lim As Integer
Dim w As Worksheet
Dim Op As Variant

Set w = ActiveSheet

'Set Lim as total number of rows in named range "F" (only 1 cell in use but same effect)
Lim = Range("F").Rows.Count

'Data has header row so skip to row 2
i = 2

'Loop through i up to limit
Do While i <= Lim
    'If the row is not hidden by the filters the user chose

    If Range("F")(i, 1).EntireRow.Hidden = False Then
        'Check if the range is nothing - if it is, union will not work to itself
        'Union requires non-empty arguments

        If Rng Is Nothing Then
            'Set the Rng to include the current cell from "F"
            Set Rng = Range("F")(i, 1)
            Sheets("Sheet2").Range("A75").Value = Range("F")(i, 1).Value
            j = j + 1
        Else
            Sheets("Sheet2").Range("A1").Offset(j, 0).Value = Range("F")(i, 1).Value
            j = j + 1
        End If

    End If

'Increment i
i = i + 1

Loop

'If there's an operator, save it as variable Op (if needed)
If w.AutoFilter.Filters.Item(1).Operator <> False Then Op = w.AutoFilter.Filters.Item(1).Operator


'Remove AutoFilter
w.AutoFilterMode = False




'Insert Code Here

'Pause between the two halves
MsgBox ""



'Put filters back

'Check for Rng being non-empty (pointless running code if it is)
If Not IsEmpty(Rng) Then
    'If there is an operator then use the range
    If Op Then
        'Found this option useful here - can transpose the array values
        'Always xlFilterValues as there will always be more than 2 options
        'Also the options are taken from the worksheet live so won't change between times so specifying them precisely as strings is ok
        Range("F").AutoFilter Field:=1, Criteria1:=Application.Transpose(Sheets("Sheet2").Range("A75").Resize(j, 1).Value), _
        Operator:=xlFilterValues
    Else
        'Just filter the range but leave all options available
        Range("F").AutoFilter Field:=1
    End If
End If


End Sub