Shaumyabrata
Shaumyabrata

Reputation: 51

Adding Dynamic changing cell values to an Autofilter Array in VBA

In Sheet1 on the excel sheet I have in Range("B6") I have a code so it might be one code this month but it can also be 3 more code added below in the next and it just could be two new in the next month so the values will keep on changing and number can range between 1 to anything it will be dynamic. Based on these values on the next Sheet2 the date needs to be filtered. So in Sheet2 I have three columns one is Sl_No. one ME_Code (This is what needs to be filtered based on Sheet 1 data) and prices

So I am new in VBA and tried the below code which is not working when there is multiple codes which I am trying to add to an Autofilter Array in VBA.

Here is my code which is not working when I am trying in the else option can someone please help me, I tried few option from StackOverflow itself but did not work

Here is my code,

Sub ToCheckArray()

Dim N As Long

Worksheets("Sheet1").Select
If IsEmpty(Range("B6").Offset(1, 0).Value) Then
    Worksheets("Sheet1").Select
    arr1 = Array(Range("B6"))
    Worksheets("Sheet2").Select
    Range("A1:C1").AutoFilter field:=2, Criteria1:=arr1, Operator:=xlFilterValues
Else
    Worksheets("Sheet1").Select
    'With Sheets("Sheet1")
        'N = .Cells(Rows.Count, "B").End(xlDown).Row
        'ReDim ary(6 To N)
        'For i = 6 To N
            'ary(i) = .Cells(i, 1)
        'Next i
    'End With

    arr1 = Array(Range("B6", Range("B6").End(xlDown)))
    Worksheets("Sheet2").Select
    Range("A1:C1").AutoFilter field:=2, Criteria1:=ary, operator:=xlFilterValues
End If

End Sub

Upvotes: 1

Views: 195

Answers (1)

DisplayName
DisplayName

Reputation: 13386

Use

Else
    Dim ary As Variant
    With Worksheets("Sheet1")
        ary = Application.Transpose(.Range("B6", .Cells(Rows.Count, "B").End(xlDown)).Value)
    End With
    Worksheets("Sheet2").Range("A1:C1").AutoFilter field:=2, Criteria1:=ary, operator:=xlFilterValues
End If

As you see, I avoided Select statement in lieu of a fully qualified range reference up to the sheet reference

So your entire code could be rewritten as follows:

Sub ToCheckArray()
    Dim ary As Variant

    With Worksheets("Sheet1")
        If IsEmpty(.Range("B6").Offset(1, 0).Value) Then
            ary = Array(.Range("B6").Value)
        Else
            ary = Application.Transpose(.Range("B6", .Cells(Rows.Count, "B").End(xlDown)).Value
        End If
    End With
    Worksheets("Sheet2").Range("A1:C1").AutoFilter field:=2, Criteria1:=ary, Operator:=xlFilterValues
End Sub

And should you be sure that Sheet1 has always a value in B6, and possible other values follow it down to the last not empty cell in column B, then it can collapse to:

Sub ToCheckArray()
    Dim ary As Variant

    With Worksheets("Sheet1")
        ary = Application.Transpose(.Range("B6", .Cells(Rows.Count, "B").End(xlUp)).Value
    End With
    Worksheets("Sheet2").Range("A1:C1").AutoFilter field:=2, Criteria1:=ary, Operator:=xlFilterValues
End Sub

Upvotes: 1

Related Questions