VBA - help troubleshooting autofilter code

gd6noob · Jun 5, 2021

Hi guys,

I have this code and all is working except if there is blank in the criteria range.

2 things:

1) From the code blow, on sheet1 the worksheetfunction.count, if the range is blank and nothing entered, my filtered results in blank. Can not figure how to fix this.
2) I want to add another criteria to filter out any entries that is within the last 7 days on Sheet2, field:=8

VBA Code:

Sub filter()
On Error Resume Next
Dim scount As Integer, fcount As Integer, shcount As Integer, dcount As Integer, stcount As Integer, tcount As Integer, dacount As Integer
Dim sitelist As Variant, fclmlist As Variant, shiftlist As Variant, deptlist As Variant, statuslist As Variant, typelist As Variant, dalist As Variant

Sheet1.Activate
scount = WorksheetFunction.CountA(Range("H5", Range("H5").End(xlDown)))
shcount = WorksheetFunction.CountA(Range("I5", Range("I5").End(xlDown)))
dcount = WorksheetFunction.CountA(Range("J5", Range("J5").End(xlDown)))
fcount = WorksheetFunction.CountA(Range("K5", Range("K5").End(xlDown)))
stcount = WorksheetFunction.CountA(Range("L5", Range("L5").End(xlDown)))
tcount = WorksheetFunction.CountA(Range("M5", Range("M5").End(xlDown)))

Set scell = ThisWorkbook.Worksheets("Dashboard").Range("H5")
Set shcell = ThisWorkbook.Worksheets("Dashboard").Range("I5")
Set dcell = ThisWorkbook.Worksheets("Dashboard").Range("J5")
Set fcell = ThisWorkbook.Worksheets("Dashboard").Range("K5")
Set stcell = ThisWorkbook.Worksheets("Dashboard").Range("L5")
Set tcell = ThisWorkbook.Worksheets("Dashboard").Range("M5")


    sitelist = Range(Cells(5, 8), Cells(scount, 8)).Value
    sitelist = Application.Transpose(sitelist)
    sitelist = Join(sitelist, ",")
    sitelist = Split(sitelist, ",")
   
    shiftlist = Range(Cells(5, 9), Cells(shcount, 9)).Value
    shiftlist = Application.Transpose(shiftlist)
    shiftlist = Join(shiftlist, ",")
    shiftlist = Split(shiftlist, ",")
   
    deptlist = Range(Cells(5, 10), Cells(dcount, 10)).Value
    deptlist = Application.Transpose(deptlist)
    deptlist = Join(deptlist, ",")
    deptlist = Split(deptlist, ",")
   
    fclmlist = Range(Cells(5, 11), Cells(fcount, 11)).Value
    fclmlist = Application.Transpose(fclmlist)
    fclmlist = Join(fclmlist, ",")
    fclmlist = Split(fclmlist, ",")
   
    statuslist = Range(Cells(5, 12), Cells(stcount, 12)).Value
    statuslist = Application.Transpose(statuslist)
    statuslist = Join(statuslist, ",")
    statuslist = Split(statuslist, ",")
   
    typelist = Range(Cells(5, 13), Cells(tcount, 13)).Value
    typelist = Application.Transpose(typelist)
    typelist = Join(typelist, ",")
    typelist = Split(typelist, ",")
      
    With Sheet2
        .Range("A1:I1").AutoFilter field:=1, Criteria1:=sitelist
        .Range("A1:I1").AutoFilter field:=3, Criteria1:=statuslist
        .Range("A1:I1").AutoFilter field:=4, Criteria1:=shiftlist
        .Range("A1:I1").AutoFilter field:=5, Criteria1:=deptlist
        .Range("A1:I1").AutoFilter field:=6, Criteria1:=fclmlist
        .Range("A1:I1").AutoFilter field:=7, Criteria1:=typelist
    End With

End Sub

Alex Blakenburg · Jun 7, 2021

Please save a copy of your code current workbook & code and then try try this:

The count formulas seem to set the wrong last row number so I have changed them
The join and split lines seem unnecessary
The transpose returns a zero when the criteria range is empty hence the addition of
"if criteria <> 0 then apply filter"
An array filter seems to need the: Operator:=xlFilterValues
**** right at the end I have put a line to accommodate your date request ****
- I did not know which field is your date field so you will need to change the field no
- you will also need to check if you want >= I currently have just >
- The line is:-
  .AutoFilter field:=6, Criteria1:=">" & (CLng(Date) - 7)

VBA Code:

Sub filter()
    On Error Resume Next
    Dim scount As Integer, fcount As Integer, shcount As Integer, dcount As Integer, stcount As Integer, tcount As Integer, dacount As Integer
    Dim sitelist As Variant, fclmlist As Variant, shiftlist As Variant, deptlist As Variant, statuslist As Variant, typelist As Variant, dalist As Variant
    ' ADDED
    Dim scell As Range, shcell As Range, dcell As Range, fcell As Range, stcell As Range, tcell As Range
    
    ' CHANGED
    Sheet1.Activate
    scount = Range("H5").End(xlDown).Row
    shcount = Range("I5").End(xlDown).Row
    dcount = Range("J5").End(xlDown).Row
    fcount = Range("K5").End(xlDown).Row
    stcount = Range("L5").End(xlDown).Row
    tcount = Range("M5").End(xlDown).Row
    
    Set scell = ThisWorkbook.Worksheets("Dashboard").Range("H5")
    Set shcell = ThisWorkbook.Worksheets("Dashboard").Range("I5")
    Set dcell = ThisWorkbook.Worksheets("Dashboard").Range("J5")
    Set fcell = ThisWorkbook.Worksheets("Dashboard").Range("K5")
    Set stcell = ThisWorkbook.Worksheets("Dashboard").Range("L5")
    Set tcell = ThisWorkbook.Worksheets("Dashboard").Range("M5")
       
    sitelist = Range(Cells(5, 8), Cells(scount, 8)).Value
    sitelist = Application.Transpose(sitelist)

    shiftlist = Range(Cells(5, 9), Cells(shcount, 9)).Value
    shiftlist = Application.Transpose(shiftlist)

    deptlist = Range(Cells(5, 10), Cells(dcount, 10)).Value
    deptlist = Application.Transpose(deptlist)
  
    fclmlist = Range(Cells(5, 11), Cells(fcount, 11)).Value
    fclmlist = Application.Transpose(fclmlist)
    
    statuslist = Range(Cells(5, 12), Cells(stcount, 12)).Value
    statuslist = Application.Transpose(statuslist)
    
    typelist = Range(Cells(5, 13), Cells(tcount, 13)).Value
    typelist = Application.Transpose(typelist)

    Sheet2.ShowAllData
    With Sheet2.Range("A1:I1")
        If sitelist <> 0 Then .AutoFilter field:=1, Criteria1:=sitelist, Operator:=xlFilterValues
        If statuslist <> 0 Then .AutoFilter field:=3, Criteria1:=statuslist, Operator:=xlFilterValues
        If shiftlist <> 0 Then .AutoFilter field:=4, Criteria1:=shiftlist, Operator:=xlFilterValues
        If deptlist <> 0 Then .AutoFilter field:=5, Criteria1:=deptlist, Operator:=xlFilterValues
        'If fclmlist <> 0 Then .AutoFilter field:=6, Criteria1:=fclmlist, Operator:=xlFilterValues
        If typelist <> 0 Then .AutoFilter field:=7, Criteria1:=typelist, Operator:=xlFilterValues
         
' XXXXX Change the Field to be whatever the date field is XXXXX
         .AutoFilter field:=6, Criteria1:=">" & (CLng(Date) - 7)
     End With

End Sub

gd6noob · Jun 7, 2021

Thank you for helping, I ran into an issue,

When I got to filter the deptlist and fclmlist, its giving me blank. My mind is boggled as to why. Everything else filtered correctly, even the date.

Below is my list of criteria.

Quebec Call'em All.xlsb

H

I

J

K

L

M

5

Site

Shift Pattern

Department

FCLM Area

Status

Type

6

DB3C0700

1299010

3

Active

Hourly

7

1299030

8

Dashboard

Below is the list that needs to be filtered.

Quebec Call'em All.xlsb

A

B

C

D

E

F

G

H

I

1

Location: Location Name

Employee Id

Payroll Employee Status

Shift Pattern

Department

FCLM Area

Employee Type

Last Hire Date

Mobile Phone - Private

2

Active

NA6C1815

1299010

3

Hourly

7/2/2020

3

Active

ACCCOM

1299070

3

Hourly

7/2/2020

4

Active

NL4C1830

1299060

3

Hourly

8/5/2020

5

Active

NA5C1815

129940

5

Hourly

7/2/2020

6

Active

NB3C1845

1299030

13

Hourly

8/2/2020

7

Active

NN4C1900

1299030

13

Hourly

8/3/2020

8

Active

NB2C1830

1299010

3

Hourly

7/5/2020

9

Active

NB2C1830

1299010

3

Hourly

7/5/2020

Roster

Alex Blakenburg · Jun 7, 2021

It is still quite early here in Australia so I will modify the code later today.
I think you just told me what the split/join does. The 2 that are failing are numeric and need to be text. You can test it by putting back the split/join for those columns if you want to try it.
The If statement will need to be modified though.
I also want change the xldown lines to starting at rows.count and using xlup, to cover off having an empty list.

gd6noob · Jun 7, 2021

Alex Blakenburg said:
It is still quite early here in Australia so I will modify the code later today.
I think you just told me what the split/join does. The 2 that are failing are numeric and need to be text. You can test it by putting back the split/join for those columns if you want to try it.
The If statement will need to be modified though.
I also want change the xldown lines to starting at rows.count and using xlup, to cover off having an empty list.

This worked.

modified to rows.count and added back the join/split code and now it filters those 2 columns correct. Thank you

VBA Code:

    scount = ActiveSheet.Cells(Rows.count, "H").End(xlUp).Row
    shcount = ActiveSheet.Cells(Rows.count, "I").End(xlUp).Row
    dcount = ActiveSheet.Cells(Rows.count, "J").End(xlUp).Row
    fcount = ActiveSheet.Cells(Rows.count, "K").End(xlUp).Row
    dacount = ActiveSheet.Cells(Rows.count, "N").End(xlUp).Row

Thank you for all the help.

Alex Blakenburg · Jun 8, 2021

Thanks for the update.

There are some other changes that you might want to include. (Look for XXXXX in the code)

if there are no criteria in a criteria column the xlup will overshoot what is currently supposed to be the first row of the filter range namely row 5.
So added a check that if xlup is giving a row no < than your first filter data row (currently 5) to use the firstRow instead
eg If scount < firstRow Then scount = firstRow
Since there is now a variable for the firstRow I changed all the list variables to use that as the row reference for the starting cell.
eg shiftlist = Range(Cells(firstRow, 9), Cells(shcount, 9)).Value
For your numeric fields (deptlist & fclmlist) if they only contain 1 value it is not converting to a string which means it doesn't work in the filter. So added this line to convert non-empty single value non-array variable to a string.
If Not IsArray(deptlist) And deptlist <> 0 Then deptlist = CStr(deptlist)
I don't know what field you are using for your date filter so it is currently a line at the end that is commented out.

VBA Code:

Sub filter()
    On Error Resume Next
    Dim scount As Integer, fcount As Integer, shcount As Integer, dcount As Integer, stcount As Integer, tcount As Integer, dacount As Integer
    Dim sitelist As Variant, fclmlist As Variant, shiftlist As Variant, deptlist As Variant, statuslist As Variant, typelist As Variant, dalist As Variant

    Dim scell As Range, shcell As Range, dcell As Range, fcell As Range, stcell As Range, tcell As Range
    
    Sheet1.Activate
    scount = ActiveSheet.Cells(Rows.Count, "H").End(xlUp).Row
    shcount = ActiveSheet.Cells(Rows.Count, "I").End(xlUp).Row
    dcount = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
    fcount = ActiveSheet.Cells(Rows.Count, "K").End(xlUp).Row
    dacount = ActiveSheet.Cells(Rows.Count, "N").End(xlUp).Row
    
    Set scell = ThisWorkbook.Worksheets("Dashboard").Range("H5")
    Set shcell = ThisWorkbook.Worksheets("Dashboard").Range("I5")
    Set dcell = ThisWorkbook.Worksheets("Dashboard").Range("J5")
    Set fcell = ThisWorkbook.Worksheets("Dashboard").Range("K5")
    Set stcell = ThisWorkbook.Worksheets("Dashboard").Range("L5")
    Set tcell = ThisWorkbook.Worksheets("Dashboard").Range("M5")
       
    ' XXXX ADDED XXXX
    Dim firstRow As Long
    firstRow = 5
    If scount < firstRow Then scount = firstRow
    If shcount < firstRow Then shcount = firstRow
    If dcount < firstRow Then dcount = firstRow
    If fcount < firstRow Then fcount = firstRow
    If dacount < firstRow Then dacount = firstRow
    
    ' XXXX CHANGED XXXX
    sitelist = Range(Cells(firstRow, 8), Cells(scount, 8)).Value
    sitelist = Application.Transpose(sitelist)

    shiftlist = Range(Cells(firstRow, 9), Cells(shcount, 9)).Value
    shiftlist = Application.Transpose(shiftlist)

    deptlist = Range(Cells(firstRow, 10), Cells(dcount, 10)).Value
    deptlist = Application.Transpose(deptlist)
    deptlist = Split(Join(deptlist, ","), ",")
    If Not IsArray(deptlist) And deptlist <> 0 Then deptlist = CStr(deptlist)
  
    fclmlist = Range(Cells(firstRow, 11), Cells(fcount, 11)).Value
    fclmlist = Application.Transpose(fclmlist)
    fclmlist = Split(Join(fclmlist, ","), ",")
    If Not IsArray(fclmlist) And fclmlist<> 0 Then fclmlist = CStr(fclmlist)
    
    statuslist = Range(Cells(firstRow, 12), Cells(stcount, 12)).Value
    statuslist = Application.Transpose(statuslist)
    
    typelist = Range(Cells(firstRow, 13), Cells(tcount, 13)).Value
    typelist = Application.Transpose(typelist)
    ' XXXXX END OF LATEST CHANGES XXXXX

    Sheet2.ShowAllData
    With Sheet2.Range("A1:I1")
        If sitelist <> 0 Then .AutoFilter field:=1, Criteria1:=sitelist, Operator:=xlFilterValues
        If statuslist <> 0 Then .AutoFilter field:=3, Criteria1:=statuslist, Operator:=xlFilterValues
        If shiftlist <> 0 Then .AutoFilter field:=4, Criteria1:=shiftlist, Operator:=xlFilterValues
        If deptlist <> 0 Then .AutoFilter field:=5, Criteria1:=deptlist, Operator:=xlFilterValues
        If fclmlist <> 0 Then .AutoFilter field:=6, Criteria1:=fclmlist, Operator:=xlFilterValues
        If typelist <> 0 Then .AutoFilter field:=7, Criteria1:=typelist, Operator:=xlFilterValues
         
' XXXXX Change the Field to be whatever the date field is XXXXX
         '.AutoFilter field:=6, Criteria1:=">" & (CLng(Date) - 7)
     End With

End Sub

gd6noob · Jun 9, 2021

Thank you @Alex Blakenburg, your help is much appreciated. That worked well.

Alex Blakenburg · Jun 9, 2021

Thanks for letting me know. Glad I could help.

gd6noob · Jun 9, 2021

Follow up question, I noticed that when I use 1 wildcard criteria, the data filters correctly but when I have 2 in the same column, its returning 0 results.
i.e. on the Shift Pattern (column I), when I enter PT* (for any part time shifts) and DA* (Morning shifts sun-wed), my Roster tab would filter and I see blanks. But having only 1, it would filter fine. I can not seem to figure what is causing this.

Alex Blakenburg · Jun 10, 2021

I had a look at this and if you only have 2 items in a criteria array and they have wildcards in it, then it will work.

If you put wildcards in the selection array it switches from a "selected items filter" to a "custom filter" (either begins with, ends with or contains, depending on where you put the wildcards)

The custom filter only allows for 2 criteria.
The suggestions are:

Use advanced filter
With so many criteria combinations as you have I don't think that would work well for you.
Use a helper column

This range criteria

Generated this Custom Filter

Without the wildcards it generates this selected items filter

VBA - help troubleshooting autofilter code

gd6noob

Board Regular

Excel Facts

Alex Blakenburg

MrExcel MVP

gd6noob

Board Regular

Alex Blakenburg

MrExcel MVP

gd6noob

Board Regular

Alex Blakenburg

MrExcel MVP

gd6noob

Board Regular

Alex Blakenburg

MrExcel MVP

gd6noob

Board Regular

Alex Blakenburg

MrExcel MVP

Similar threads

Forum statistics

Share this page

VBA - help troubleshooting autofilter code

Board Regular

Excel Facts

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock