Select the search type
 
  • Site
  • Web
Search
You are here:   articles
  |  Login

Can find what you are looking for?  Try our custom Google search:

Loading
   BackToCategory   Next  1 of 3
AutoFilter - Cut, copy or delete data from a table using criteria
 
Author: Jon von der Heyden
Dated: 20/05/2010
 
Overview:
 
This is quite a common question on the forums.  The usual answer that follows involves looping through the criteria range, cell-by-cell, testing the condition and if true then delete/cut/copy the record.  But one method that is frequently overlooked, and one that tends to be considerably quicker when dealing with larger data ranges (1000's or rows rather than 100's), is to use the AutoFilter method.
 
With AutoFilter we can display all criteria matching records and delete/cut/copy the records in one hit!
 
Here are a few rules about AutoFilter that you need to be aware of before we proceed:

  • AutoFilter assumes your data table has field names (column labels).

  • AutoFilter supports up to two custom criteria (per field).

  • The limitation of the amount of entries in the AutoFilter list is 1,000 in excel 2003.  If you have more than 1,000 unique values only the first 1,000 items appear.  This has been extended to 10,000 in excel 2007+.

  • After the filter is applied excel will only allow you to select up to 8,192 non-contiguous cells.  If you attempt to select more you will encounter the following error message: 'The selection is too large'.  Therefore if dealing with particularly large ranges and this is a possibility, it is suggested that you sort your data first according to the same field(s) that you wish to apply the criteria to.

Always back-up your workbook before constructing and testing a routine that could alter your data and data structures.  The 'Undo' command cannot be used to reverse the actions of a macro!
 
Please acquaint yourself with any comments in the code as these may provide much of the explanation.  Remove the comments from your project when you are comfortable with the methods described; to maintain a tidy sub routine.
 
Contents:
 
Example table:
 
Sheet1
  A B C D
1 First Name Last Name Expense Date Amount
2 John Doe 02/06/2008 792.01
3 Mike Smith 16/02/2009 848.81
4 Mary Edwards 04/07/2008 390.08
5 John Phillips 17/02/2009 585.01
6 Jason Burns 19/02/2009 810.34
7 Paul Wilson 26/06/2008 15.23
8 John Doe 18/05/2008 713.09
9 Jason Burns 04/02/2009 246.36
10 Susan Jarvis 07/05/2008 506.3
11 Paula Jones 05/09/2008 705.23
12 John Doe 19/10/2008 389.83
13 Mike Smith 05/11/2008 796.38
14 Mary Edwards 06/10/2008 167.64
15 Jason Burns 01/08/2008 943.42
 
 
This code belongs in a standard module.
This example will filter all records where the First Name equals 'John'.
Option Explicit
'!  Written by Jon von der Heyden
'!  Excel Design Solutions Ltd
'!  www.exceldesignsolutions.com
'!  May-2010
'!  Excel 2003

Public Sub FilterRecords_1()
    Dim rngTable As Range
    Dim lngLastRow As Long
    Dim xlCalc As XlCalculation
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        xlCalc = .Calculation
        .Calculation = xlManual
        .EnableCancelKey = xlDisabled
    End With
    
    With Sheet1
        .AutoFilterMode = False
        lngLastRow = .Range("A" & Rows.Count).End(xlUp).Row
        Set rngTable = .Range("A1:D" & lngLastRow)
    End With
    
    '!  The real stuff starts here
    With rngTable
        .AutoFilter Field:=1, Criteria1:="=John"
        '!  It's good to check that your filter is returning the _
            correct results - so highlight the visible cells
        .Offset(1).SpecialCells(12).Interior.ColorIndex = 3
        '!  Copy the results to the desired location.  Comment the _
            copy statement if all you want to delete the records
        .Offset(1).SpecialCells(12).Copy Destination:=Sheet2.Range("A1")
        '!  Delete the records (alternatively delete the EntireRow)
        .Offset(1).SpecialCells(12).Delete shift:=xlUp
        '!  Copy then Delete serves as CUT
        .AutoFilter
    End With
    
    With Application
        .EnableCancelKey = xlInterrupt
        .Calculation = xlCalc
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
 
 
This code belongs in a standard module. 
This example will filter all records where the First Name equals 'John' OR 'Mary'.
Option Explicit
'!  Written by Jon von der Heyden
'!  Excel Design Solutions Ltd
'!  www.exceldesignsolutions.com
'!  May-2010
'!  Excel 2003

Public Sub FilterRecords_2()
    Dim rngTable As Range
    Dim lngLastRow As Long
    Dim xlCalc As XlCalculation
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        xlCalc = .Calculation
        .Calculation = xlManual
        .EnableCancelKey = xlDisabled
    End With
    
    With Sheet1
        .AutoFilterMode = False
        lngLastRow = .Range("A" & Rows.Count).End(xlUp).Row
        Set rngTable = .Range("A1:D" & lngLastRow)
    End With
    
    '!  The real stuff starts here
    With rngTable
        .AutoFilter Field:=1, Criteria1:="=John", Operator:=xlOr, Criteria2:="=Mary"
        '!  It's good to check that your filter is returning the _
            correct results - so highlight the visible cells
        .Offset(1).SpecialCells(12).Interior.ColorIndex = 3
        '!  Copy the results to the desired location.  Comment the _
            copy statement if all you want to delete the records
        .Offset(1).SpecialCells(12).Copy Destination:=Sheet2.Range("A1")
        '!  Delete the records (alternatively delete the EntireRow)
        .Offset(1).SpecialCells(12).Delete shift:=xlUp
        '!  Copy then Delete serves as CUT
        .AutoFilter
    End With
    
    With Application
        .EnableCancelKey = xlInterrupt
        .Calculation = xlCalc
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
 
 
This code belongs in a standard module.
This example will filter all records where the First Name equals 'John' AND the Last Name equals 'Doe'.
Option Explicit
'!  Written by Jon von der Heyden
'!  Excel Design Solutions Ltd
'!  www.exceldesignsolutions.com
'!  May-2010
'!  Excel 2003

Public Sub FilterRecords_3()
    Dim rngTable As Range
    Dim lngLastRow As Long
    Dim xlCalc As XlCalculation
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        xlCalc = .Calculation
        .Calculation = xlManual
        .EnableCancelKey = xlDisabled
    End With
    
    With Sheet1
        .AutoFilterMode = False
        lngLastRow = .Range("A" & Rows.Count).End(xlUp).Row
        Set rngTable = .Range("A1:D" & lngLastRow)
    End With
    
    '!  The real stuff starts here
    With rngTable
        .AutoFilter Field:=1, Criteria1:="=John"
        .AutoFilter Field:=2, Criteria1:="=Doe"
        '!  It's good to check that your filter is returning the _
            correct results - so highlight the visible cells
        .Offset(1).SpecialCells(12).Interior.ColorIndex = 3
        '!  Copy the results to the desired location.  Comment the _
            copy statement if all you want to delete the records
        .Offset(1).SpecialCells(12).Copy Destination:=Sheet2.Range("A1")
        '!  Delete the records (alternatively delete the EntireRow)
        .Offset(1).SpecialCells(12).Delete shift:=xlUp
        '!  Copy then Delete serves as CUT
        .AutoFilter
    End With
    
    With Application
        .EnableCancelKey = xlInterrupt
        .Calculation = xlCalc
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
 
 
This code belongs in a standard module.
This example will filter all records where First Name AND Last Names are 'John Doe', 'Mary Edwards', 'Paula Jones'.
 
Option Explicit
'!  Written by Jon von der Heyden
'!  Excel Design Solutions Ltd
'!  www.exceldesignsolutions.com
'!  May-2010
'!  Excel 2003

Public Sub FilterRecords_4()
    Dim rngTable As Range
    Dim lngLastRow As Long
    Dim xlCalc As XlCalculation
    Dim arrFNames, arrLNames, lngArrItem As Long
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        xlCalc = .Calculation
        .Calculation = xlManual
        .EnableCancelKey = xlDisabled
    End With
    
    With Sheet1
        .AutoFilterMode = False
        lngLastRow = .Range("A" & Rows.Count).End(xlUp).Row
        Set rngTable = .Range("A1:D" & lngLastRow)
    End With
    
    '!  The real stuff starts here
    arrFNames = Array("John", "Mary", "Paula")
    arrLNames = Array("Doe", "Edwards", "Jones")
    With rngTable
        For lngArrItem = LBound(arrFNames) To UBound(arrFNames)
            .AutoFilter Field:=1, Criteria1:="=" & arrFNames(lngArrItem), _
                        Operator:=xlAnd
            .AutoFilter Field:=2, Criteria1:="=" & arrLNames(lngArrItem)
            '!  It's good to check that your filter is returning the _
                correct results - so highlight the visible cells
            .Offset(1).SpecialCells(12).Interior.ColorIndex = 3
            '!  Copy the results to the desired location.  Comment the _
                copy statement if all you want to delete the records
            .Offset(1).SpecialCells(12).Copy _
                Destination:=Sheet2.Range("A" & Rows.Count).End(xlUp)(1)
            '!  Delete the records (alternatively delete the EntireRow)
            .Offset(1).SpecialCells(12).Delete shift:=xlUp
            '!  Copy then Delete serves as CUT
            .AutoFilter
        Next lngArrItem
    End With
    
    With Application
        .EnableCancelKey = xlInterrupt
        .Calculation = xlCalc
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
 
This code belongs in a standard module.
Filtering dates can be a little more tricky.  You will be better off using serial date value criteria rather than date strings.  Since serial dates are numbers the typical method is to assign a date value to a Long Integer type variable. 
Option Explicit
'!  Written by Jon von der Heyden
'!  Excel Design Solutions Ltd
'!  www.exceldesignsolutions.com
'!  May-2010
'!  Excel 2003

Public Sub FilterRecords_5()
    Dim rngTable As Range
    Dim lngLastRow As Long
    Dim xlCalc As XlCalculation
    Dim lngStartDate As Long, lngEndDate As Long
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        xlCalc = .Calculation
        .Calculation = xlManual
        .EnableCancelKey = xlDisabled
    End With
    
    With Sheet1
        .AutoFilterMode = False
        lngLastRow = .Range("A" & Rows.Count).End(xlUp).Row
        Set rngTable = .Range("A1:D" & lngLastRow)
    End With
    
    lngStartDate = DateSerial(2008, 7, 1)
    lngEndDate = DateSerial(2008, 10, 30)
    
    '!  The real stuff starts here
    With rngTable
        .AutoFilter Field:=3, Criteria1:=">=" & lngStartDate, _
                    Operator:=xlOr, Criteria2:="<=" & lngEndDate
        '!  It's good to check that your filter is returning the _
            correct results - so highlight the visible cells
        .Offset(1).SpecialCells(12).Interior.ColorIndex = 3
        '!  Copy the results to the desired location.  Comment the _
            copy statement if all you want to delete the records
        .Offset(1).SpecialCells(12).Copy Destination:=Sheet2.Range("A1")
        '!  Delete the records (alternatively delete the EntireRow)
        .Offset(1).SpecialCells(12).Delete shift:=xlUp
        '!  Copy then Delete serves as CUT
        .AutoFilter
    End With
    
    With Application
        .EnableCancelKey = xlInterrupt
        .Calculation = xlCalc
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
 
Symbol Means
"=" Blanks
"<>" Non-blanks
"=" & Criteria Equal To
"<>" & Criteria Does NOT Equal To
">" & Criteria Greater Than
"<" & Criteria Less Than
"<=" & Criteria Less Than OR Equal To
">=" & Criteria Greater Than OR Equal To
"=*" & Criteria Begins With
"<>*" & Criteria Does NOT Begin With
"=" & Criteria & "*" Ends With
"<>" & Criteria & "*" Does NOT End With
"=*" & Criteria & "*" Contains
"<>*" & Criteria & "*" Does NOT Contain
 
Note - AutoFilter criteria is case insensitive.
 
See Also:
 
 
 
External References:
 

 
   BackToCategory   Next  1 of 3

home   |   articles   |   downloads   |   about   |   contact