none
Run-time error '1004': AutoFilter method of range class failed

    Question

  • Hello Forum,

    I'm sure you have seen this error before: "Run-time error '1004': AutoFilter method of range class failed".

    What I'm trying to do is find and mark the duplicates based on their value in column A.  Then, if the item is a duplicate, copy the duplicates to a new sheet, otherwise do nothing with the non-duplicate items.

    I'm getting this error at the line marked below.  I have tried deleting the "GPT2_Data" sheet and then adding a new sheet and calling it "GPT2_Data" just like it is supposed to be and still it gives me the error same.  The same code is applied to the other three sheets but it keeps failing at the GPT2 sheet area.  Also, all three sheets have the same properties.

    When the block of code, starting with and including "Sheets("GPT2_Data").Activate" and ending before "Sheets("PT3_Data").Activate", is commented out, the macro works just right. 

    Here is the code:

    Option Explicit
    Sub FindDuplicates_Pumps()
    On Error Resume Next
        Application.DisplayAlerts = False
        Sheets("Pump Duplicates").Delete
        Sheets("Cylinder Duplicates").Delete
        
        On Error GoTo 0
        Application.DisplayAlerts = True
    If WorksheetExists("Pump Duplicates") = False Then
        Dim PumpSheet As Worksheet
        Set PumpSheet = Sheets.Add
        PumpSheet.Name = "Pump Duplicates"
    End If
    '--------------------------
    'Find Pump Duplicates!
    '--------------------------
    Dim n As Long
    Dim i As Integer
    Sheets("GPT1_Data").Activate
        n = Range("A" & Rows.Count).End(xlUp).Row
        'Find duplicates from Column A and identify them with a 1 in Column AB
        For i = 1 To n
            If Application.CountIf(Range("A" & i & ":A" & n), Range("A" & i).Text) > 1 Then
                Range("AB" & i).Value = 1
            End If
        Next i
        
        Range("A1:AB10000").AutoFilter , Field:=28, Criteria1:=1 'Find the 1's
        Range("A1", Range("A65536").End(xlUp)).EntireRow.Copy 'Copy the duplicates
        PumpSheet.Range("A65536").End(xlUp).Offset(0, 0).PasteSpecial xlPasteValues 'Paste the duplicates
        ActiveSheet.AutoFilterMode = False
        
    Sheets("GPT2_Data").Activate
        n = Range("A" & Rows.Count).End(xlUp).Row
        'Find duplicates from Column A and identify them with a 1 in Column AB
        For i = 1 To n
            If Application.CountIf(Range("A" & i & ":A" & n), Range("A" & i).Text) > 1 Then
                Range("AB" & i).Value = 1
            End If
        Next i
        
    'Macro fails on the line below
        Range("A1:AB10000").AutoFilter , Field:=28, Criteria1:=1 'Find the 1's
    'Macro fails on the line above
        Range("A1", Range("A65536").End(xlUp)).EntireRow.Copy 'Copy the duplicates
        PumpSheet.Range("A65536").End(xlUp).Offset(0, 0).PasteSpecial xlPasteValues 'Paste the duplicates
        ActiveSheet.AutoFilterMode = False
        
    Sheets("GPT3_Data").Activate
        n = Range("A" & Rows.Count).End(xlUp).Row
        'Find duplicates from Column A and identify them with a 1 in Column AB
        For i = 1 To n
            If Application.CountIf(Range("A" & i & ":A" & n), Range("A" & i).Text) > 1 Then
                Range("AB" & i).Value = 1
            End If
        Next i
        
        Range("A1:AB10000").AutoFilter , Field:=28, Criteria1:=1 'Find the 1's
        Range("A1", Range("A65536").End(xlUp)).EntireRow.Copy 'Copy the duplicates
        PumpSheet.Range("A65536").End(xlUp).Offset(0, 0).PasteSpecial xlPasteValues 'Paste the duplicates
        ActiveSheet.AutoFilterMode = False
        
    Sheets("GPT4_Data").Activate
        n = Range("A" & Rows.Count).End(xlUp).Row
        'Find duplicates from Column A and identify them with a 1 in Column AB
        For i = 1 To n
            If Application.CountIf(Range("A" & i & ":A" & n), Range("A" & i).Text) > 1 Then
                Range("AB" & i).Value = 1
            End If
        Next i
        
        Range("A1:AB10000").AutoFilter , Field:=28, Criteria1:=1 'Find the 1's
        Range("A1", Range("A65536").End(xlUp)).EntireRow.Copy 'Copy the duplicates
        PumpSheet.Range("A65536").End(xlUp).Offset(0, 0).PasteSpecial xlPasteValues 'Paste the duplicates
        ActiveSheet.AutoFilterMode = False
        
        'Selection.AutoFilter
        
        With Sheets("Pump Duplicates").Cells(1).Resize(1, 26) 'Resize columns
            .Columns.AutoFit
        End With
        
        Sheets("Pump Duplicates").Columns(28).Font.Color = RGB(255, 255, 255) '"hide" the 1's from the user
        
        Sheets("Pump Duplicates").Select
        Range("A2").Select
        ActiveWindow.FreezePanes = True
    '---------------------------------------------
    'If there are no duplicates, delete the sheet.
    '---------------------------------------------
    Sheets("Pump Duplicates").Activate
        If WorksheetFunction.CountA(Cells(2, 1)) = 0 Then
            Application.DisplayAlerts = False
            Sheets("Pump Duplicates").Delete
            Application.DisplayAlerts = True
            MsgBox ("There are no pump duplicates.")
        Else
            Sheets("Pump Duplicates").Activate
        End If
    End Sub

    Thanks for your help!

    Auburn University Student IT/MIS Intern War Eagle!

    Wednesday, March 14, 2012 2:59 PM

Answers

  • Easy! Autofilter fails if it doesn't find any matching data.  So you need to use the find method to test if the value exists before setting autofilter like this

    set c = Range("A1:AB10000").find(what:="1",lookin:=xlvalues,lookat:=xlwhole)

    if not c is nothing then

        Range("A1:AB10000").AutoFilter , Field:=28, Criteria1:=1 'Find the 1's

        'add the rest of your code here

    end if


    jdweng

    Thursday, March 15, 2012 3:25 AM

All replies

  • Easy! Autofilter fails if it doesn't find any matching data.  So you need to use the find method to test if the value exists before setting autofilter like this

    set c = Range("A1:AB10000").find(what:="1",lookin:=xlvalues,lookat:=xlwhole)

    if not c is nothing then

        Range("A1:AB10000").AutoFilter , Field:=28, Criteria1:=1 'Find the 1's

        'add the rest of your code here

    end if


    jdweng

    Thursday, March 15, 2012 3:25 AM
  • Ahh ok, I didn't know that.

    Thanks!!


    Auburn University Student IT/MIS Intern War Eagle!

    Thursday, March 15, 2012 10:46 AM