VBA Filter code not working with blank variable criteria

[Dunk4Divin]

Hi All

I have a problem with the code below which as it stands, it works. But if you read through you will see that the last section with arrays for the selected criteria doesn't include all the possible variables i.e. it is possible to select up to 12 engineers but if include all 12 references into the array it fails because there is only 7 engineers selected for my example leaving 5 blank cells, the same issue occurs with the second and third arrays. How do I get the arrays to "ignore" the blank cells?

Any help will be gratefully received, thanks in advance

Sub FilterData()


    On Error GoTo EH:
    ActiveSheet.ShowAllData
EH:
Dim Engineer1, Engineer2, Engineer3, Engineer4, Engineer5, Engineer6, Engineer7, Engineer8, Engineer9, Engineer10, Engineer11, Engineer12 As Range

With Worksheets("Team Sheet")
Set Engineer1 = .Range("A4")
Set Engineer2 = .Range("A5")
Set Engineer3 = .Range("A6")
Set Engineer4 = .Range("A7")
Set Engineer5 = .Range("A8")
Set Engineer6 = .Range("A9")
Set Engineer7 = .Range("A10")
Set Engineer8 = .Range("A11")
Set Engineer9 = .Range("A12")
Set Engineer10 = .Range("A13")
Set Engineer11 = .Range("A14")
Set Engineer12 = .Range("A15")

Dim PartStatus1, PartStatus2, PartStatus3, PartStatus4, PartStatus5, PartStatus6, PartStatus7, PartStatus8
With Worksheets("FilterChoiceSelection")
Set PartStatus1 = .Range("C6")
Set PartStatus2 = .Range("C7")
Set PartStatus3 = .Range("C8")
Set PartStatus4 = .Range("C9")
Set PartStatus5 = .Range("C10")
Set PartStatus6 = .Range("C11")
Set PartStatus7 = .Range("C12")
End With


Dim StatusCode1, StatusCode2, StatusCode3, StatusCode4, StatusCode5
With Worksheets("FilterChoiceSelection")
Set StatusCode1 = .Range("E6")
Set StatusCode2 = .Range("E7")
Set StatusCode3 = .Range("E8")
Set StatusCode4 = .Range("E9")
Set StatusCode5 = .Range("E10")
End With

Dim RowCount

With Worksheets("CalcData")
Set RowCount = .Range("B2")
Dim Copyrange As String
Lastrow = RowCount
Copyrange = "A1:DE" & Lastrow
End With

With Worksheets("Data")
            .AutoFilterMode = False
    With .Range(Copyrange)
        .AutoFilter 9, Array(Engineer1, Engineer2, Engineer3, Engineer4, Engineer5, Engineer6, Engineer7), Operator:=xlFilterValues
        .AutoFilter 16, Array(PartStatus1, PartStatus2), Operator:=xlFilterValues
        .AutoFilter 17, Array(StatusCode1, StatusCode2), Operator:=xlFilterValues
    End With
End With
End With

End Sub

 

[kevin9999]

How do I get the arrays to "ignore" the blank cells?

If it was my project, I would do it like this (guessing your data layout of course) to ignore blanks in the 3 ranges that contain possible values. Please try it on a copy of your workbook.

Option Explicit
Sub Dunk4Divin()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Set ws1 = Worksheets("Team Sheet")
    Set ws2 = Worksheets("FilterChoiceSelection")
    Set ws3 = Worksheets("Data")    
    Dim eng, part, stat, c As Range, i As Long
    
    'Get the engineer array
    ReDim eng(1 To 12) As Variant
    i = 1
    For Each c In ws1.Range("A4:A15")
        If c.Value2 <> "" Then
            eng(i) = c.Value
            i = i + 1
        End If
    Next c
    ReDim Preserve eng(1 To i - 1)
    
    'Get the part array
    ReDim part(1 To 7) As Variant
    i = 1
    For Each c In ws2.Range("C6:C12")
        If c.Value2 <> "" Then
            part(i) = c.Value
            i = i + 1
        End If
    Next c
    ReDim Preserve part(1 To i - 1)
    
    'Get the status array
    ReDim stat(1 To 5) As Variant
    i = 1
    For Each c In ws2.Range("E6:E10")
        If c.Value2 <> "" Then
            stat(i) = c.Value
            i = i + 1
        End If
    Next c
    ReDim Preserve stat(1 To i - 1)
    
    'Apply filter
    If ws3.AutoFilterMode Then ws3.AutoFilter.ShowAllData
    With ws3.Range("A1").CurrentRegion
        .AutoFilter 9, Array(eng), 7
        .AutoFilter 16, Array(part), 7
    .AutoFilter 17, Array(stat), 7
    End With
End Sub

 

[Peter_SSs]

Notes regarding your code

Dim Engineer1, Engineer2, Engineer3, Engineer4, Engineer5, Engineer6, Engineer7, Engineer8, Engineer9, Engineer10, Engineer11, Engineer12 As Range

In this line, only Engineer12 is declared as a Range. The other 11 'Engineer' variables will be the default Variant type. This may not stop your code from working but in general I would recommend declaring variables as a specific type where relevant. To do that the above line of code would need to be

Dim Engineer1 As Range, Engineer2 As Range, Engineer3 As Range, Engineer4 As Range etc

There are a lot of other variables in your code that also look like you intend them to be Range type but are not specifically declared that way.

BTW, I suggest that you update your forum profile (click your user name at the top right of the forum, then ‘Account details’) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

 

[Dunk4Divin]

If it was my project, I would do it like this (guessing your data layout of course) to ignore blanks in the 3 ranges that contain possible values. Please try it on a copy of your workbook.

Option Explicit
Sub Dunk4Divin()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Set ws1 = Worksheets("Team Sheet")
    Set ws2 = Worksheets("FilterChoiceSelection")
    Set ws3 = Worksheets("Data")   
    Dim eng, part, stat, c As Range, i As Long
   
    'Get the engineer array
    ReDim eng(1 To 12) As Variant
    i = 1
    For Each c In ws1.Range("A4:A15")
        If c.Value2 <> "" Then
            eng(i) = c.Value
            i = i + 1
        End If
    Next c
    ReDim Preserve eng(1 To i - 1)
   
    'Get the part array
    ReDim part(1 To 7) As Variant
    i = 1
    For Each c In ws2.Range("C6:C12")
        If c.Value2 <> "" Then
            part(i) = c.Value
            i = i + 1
        End If
    Next c
    ReDim Preserve part(1 To i - 1)
   
    'Get the status array
    ReDim stat(1 To 5) As Variant
    i = 1
    For Each c In ws2.Range("E6:E10")
        If c.Value2 <> "" Then
            stat(i) = c.Value
            i = i + 1
        End If
    Next c
    ReDim Preserve stat(1 To i - 1)
   
    'Apply filter
    If ws3.AutoFilterMode Then ws3.AutoFilter.ShowAllData
    With ws3.Range("A1").CurrentRegion
        .AutoFilter 9, Array(eng), 7
        .AutoFilter 16, Array(part), 7
    .AutoFilter 17, Array(stat), 7
    End With
End Sub

Thanks Kevin It works a treat! One question though what are the 7's at the end of the three lines of code for the filters, I thought they should be the length of the arrays including the blank items, but it didn't work when I changed them. I'm self taught and mostly beg, borrow, steal or recycle code to suit my purposes, so I'm probably what you'd call an enthusiastic (but lazy) amateur - .
Thanks again
Duncan

 

[kevin9999]

Glad it worked. The 7 is the VBA 'enumeration' (shorthand) equivalent of Operator:=xlFilterValues

 

[Peter_SSs]

Glad you got a successful outcome. Still would be good if you would update your profile so helpers can provide better targeted help next time you have a question. See the last paragraph in my previous post.

For example, if I knew that you had an Excel version with the TEXTJOIN function then I would have suggested a code like this that requires no looping through worksheet cells, no re-Diming arrays etc

Sub Dunk4Divin_v2()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim eng As Variant, part As Variant, stat As Variant
    
    Set ws1 = Worksheets("Team Sheet")
    Set ws2 = Worksheets("FilterChoiceSelection")
    Set ws3 = Worksheets("Data")
    
    'Get the engineer array
    eng = Split(Application.TextJoin("|", 1, ws1.Range("A4:A15")), "|")
    
    'Get the part array
    part = Split(Application.TextJoin("|", 1, ws2.Range("C6:C12")), "|")
    
    'Get the status array
    stat = Split(Application.TextJoin("|", 1, ws2.Range("E6:E10")), "|")
    
    'Apply filter
    If ws3.AutoFilterMode Then ws3.AutoFilter.ShowAllData
    With ws3.Range("A1").CurrentRegion
        .AutoFilter 9, Array(eng), 7
        .AutoFilter 16, Array(part), 7
    .AutoFilter 17, Array(stat), 7
    End With
End Sub

 

[Peter_SSs]

Thanks Kevin It works a treat!

The marked solution has been changed accordingly. In your future questions, please mark the post as the solution that actually answered your question, instead of your feedback message as it will help future readers. No further action is required for this thread.

I do note that you have now updated your profile to show your Excel version. Thanks for that.
Given that you have Excel 365 though, instead of those 9-line pieces of code to establish each AutoFilter array, you could use the 1-liners as given in post #6.

 

[kevin9999]

Given that you have Excel 365 though, instead of those 9-line pieces of code to establish each AutoFilter array, you could use the 1-liners as given in post #6

Totally agree with Peter there - you may as well use all functionality available to you @Dunk4Divin - suggest you change the solution accordingly (If it helps, I would use Peter's solution).