Andrew Pickett
Andrew Pickett

Reputation: 51

Trouble filtering out rows on one worksheet based on an array with values from another worksheet in VBA

My intention was to have the following code compile data from my "Low CPM 1" worksheet into an array and then filter my active worksheet based on this array. While the macro does seem to affect the filters, none of the values get filtered out. Any help on this matter would be greatly appreciated

  Sub Macro1()

Dim CPM1Array(0 To 300) As Variant

For i = 2 To UBound(CPM1Array)
    CPM1Array(i) = Sheets("Low CPM 1").Cells(i, 2).Value
Next i

    ActiveSheet.Range("$A$1:$H$251").AutoFilter Field:=3, Criteria1:=("<>1 to Ubound(CPM1Array)"), Operator:=xlFilterValues

End Sub

Upvotes: 4

Views: 538

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149277

There is no simple way with autofilter to achieve what you want. You cannot use Criteria1:="<>MyArray"

Alternative

  1. We know which values we do not want. We can find out what are the values of the relevant column
  2. Simply store the values of the relevant column in an array and then remove the unnecessary values from it by comparing it with the array which has values we do not want.
  3. Remove blank cells from the array
  4. Pass the final array to the autofilter.

In Action

Let's say our worksheet looks like as shown in the below image. I am taking an example of only 15 rows.

enter image description here

Code

Sub Sample()
    Dim ws As Worksheet
    Dim MyAr(1 To 5) As String
    Dim tmpAr As Variant, ArFinal() As String
    Dim LRow As Long

    ReDim ArFinal(0 To 0)

    Set ws = ActiveSheet

    '~~> Creating an array of values which we do not want
    For i = 1 To 5
        MyAr(i) = i
    Next i

    With ws
        '~~> Last Row of Col C sice you will filter on 3rd column
        LRow = .Range("C" & .Rows.Count).End(xlUp).Row

        '~~> Storing the values form C in the array
        tmpAr = .Range("C2:C" & LRow).Value

        '~~> Compare and remove values which we do not want
        For i = 1 To LRow - 1
            For j = 1 To UBound(MyAr)
                If tmpAr(i, 1) = MyAr(j) Then tmpAr(i, 1) = ""
            Next j
        Next i

        '~~> Remove blank cells from the array by copying them to a new array
        For i = LBound(tmpAr) To UBound(tmpAr)
            If tmpAr(i, 1) <> "" Then
                ArFinal(UBound(ArFinal)) = tmpAr(i, 1)
                ReDim Preserve ArFinal(0 To UBound(ArFinal) + 1)
            End If
        Next i

        '~~> Filter on values which you want. Change range as applicable
        .Range("$A$1:$H$15").AutoFilter Field:=3, Criteria1:=ArFinal, Operator:=xlFilterValues
    End With
End Sub

Output

enter image description here

Upvotes: 4

Related Questions