Excel VBA Filter resulting in Method Autofilter of Object Range Failed

I have written a VBA command to use a range value in the tab where the DataTable resides as a filter.

I want to perform the filter on the table and then copy the range of data to a another tab.

The Data to be used as a filter is in cells A1:A2 (A1 is the field heading)

The DataTable begins in cell A7 and the length of the table can vary depending on how many records are returned from the data source.

I think what is happening is that if a filter has been previously done, the DataTable is still reflecting the previous filter.

What is syntax to display the whole data table before performing the new filter?

I have attached a screen shot of the DataTable I want to apply the filter to.

Here is the code I am using:

'
'
'   Select Data from MeditechData tab and Name Range
'
'

   
    Sheets("MeditechData").Select
    ActiveWorkbook.Names("DataRange").Delete
    Sheets("MeditechData").Select
    Range("A5").CurrentRegion.Select
   
    ActiveWorkbook.Names.Add Name:="DataRange", RefersTo:=Selection
   
'
'
'   Apply Filter
'
'

    Selection.AutoFilter
    Range("DataRange").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("A1:A2"), Unique:=False
   
'
'
'   Select Filtered Data and copy to clipboard
'
'
    Range("A5").CurrentRegion.Select
    Selection.Copy
   
 '


Thanks

Glen
Denial-FilterDara.jpg
GPSPOWAsked:
Who is Participating?
 
byundtConnect With a Mentor Commented:
In your actual macro & workbook, I modified the code as follows:

Sub FilterData()
'
' Filer Data and Copy to PT_Lookup tab

'
'
'   Unhide Columns on PT_Lookup tab
'
'


    Sheets("Pt_Lookup").Select
    
    Columns("D:N").Select
    'Range("D4").Activate
    Selection.EntireColumn.Hidden = False
    
'
'
'   Clear Contents in PT_Lookup area
'
'

    
    Range("E7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.ClearContents
'
'
'   Select Data from MeditechData tab and Name Range
'
'

    
    Sheets("MeditechData").Select
    ActiveWorkbook.Names("DataRange").Delete
    Sheets("MeditechData").Select
    Range("A5").CurrentRegion.Select
    
    ActiveWorkbook.Names.Add Name:="DataRange", RefersTo:="=" & Selection.Address
    
'
'
'   Apply Filter
'
'

    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
    Range("DataRange").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("A1:A2"), Unique:=False
    
'
'
'   Select Filtered Data and copy to clipboard
'
'
    Range("A5").CurrentRegion.Select
    Selection.Copy
    
 '
 '
 '  Select PT_Lookup tab and paste clipboard ccontents
 '
 '
    Sheets("Pt_Lookup").Select
    Range("E7").Select
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  '
  '
  ' Hide PT_Lookup Columns
  '
  '
    Columns("E:M").Select
    'Range("E4").Activate
    Selection.EntireColumn.Hidden = True
End Sub

Open in new window

0
 
Saqib Husain, SyedEngineerCommented:
Can you upload a small portion of your file for testing? You may fake the values.
0
 
GPSPOWAuthor Commented:
Here is the file with the data value copied to save space.

Thanks

Glen
Test-Denials.xlsm
0
Learn to develop an Android App

Want to increase your earning potential in 2018? Pad your resume with app building experience. Learn how with this hands-on course.

 
byundtCommented:
I rewrote your macro to copy the data to Sheet2. I used ShowAllData to undo the Advanced Filter.

Sub FilterIt()
Dim nm As Name
Dim addr As String
'
'   Select Data from MeditechData tab and Name Range
With Sheets("MeditechData")
    addr = .Range("A5").CurrentRegion.Address
    On Error Resume Next
    .ShowAllData
    Set nm = ActiveWorkbook.Names("DataRange")
    On Error GoTo 0
    If nm Is Nothing Then
        Set nm = ActiveWorkbook.Names.Add(Name:="DataRange", RefersTo:="='" & .Name & "'!" & addr)
    Else
        nm.RefersTo = "='" & .Name & "'!" & addr
    End If
    
'   Apply Filter
    .Range("DataRange").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        .Range("A1:A2"), Unique:=False

'   Select Filtered Data and copy to clipboard
    nm.RefersToRange.Copy
End With

Worksheets("Sheet2").Range("A5").PasteSpecial xlPasteValues
End Sub

Open in new window

0
 
GPSPOWAuthor Commented:
The first solution did not work.  The second one was perfect.

Thank you very much

Glen
0
 
byundtCommented:
The first solution did not work.  The second one was perfect.
The first suggestion followed good professional practices, did what you requested in your question, and worked in tests on my sample workbook. It required modification to do the full job in your actual workbook, however, because your macro was also doing things besides the requested named range change, filter & copy.

The second solution worked without needing change in your actual workbook, but it started with a recorded macro and therefore embodied a number of poor coding practices (such as selecting ranges and worksheets, needlessly deleting named ranges).

I've rewritten the second macro following more professional coding practices. It will work unchanged in your posted workbook.
Sub FilterData2()
Dim rgDest As Range
Dim nm As Name
Dim addr As String
Application.ScreenUpdating = False

' Filter Data and Copy to PT_Lookup tab

'           Unhide Columns on PT_Lookup tab
    With Worksheets("Pt_Lookup")
        .Range("D:N").EntireColumn.Hidden = False
'
'           Clear Contents in PT_Lookup area
        Set rgDest = .Range("E7")
        Set rgDest = Range(rgDest, rgDest.End(xlDown))
        Set rgDest = Range(rgDest, rgDest.End(xlToRight))
        rgDest.ClearContents
    End With

'           Select Data from MeditechData tab and Name Range
    With Worksheets("MeditechData")
        addr = "='" & .Name & "'!" & .Range("A5").CurrentRegion.Address
        On Error Resume Next
        Set nm = ActiveWorkbook.Names("DataRange")
        If nm Is Nothing Then Set nm = ActiveWorkbook.Names.Add(Name:="DataRange", RefersTo:=addr)
        On Error GoTo 0
        nm.RefersTo = addr
    
'           Apply Filter
        If .FilterMode Then .ShowAllData
        .Range("DataRange").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=.Range("A1:A2"), Unique:=False
        
'           Select Filtered Data and copy to clipboard
        .Range("A5").CurrentRegion.Copy
    End With
 
 '  Select PT_Lookup tab and paste clipboard ccontents
    rgDest.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
  
  ' Hide PT_Lookup Columns
    rgDest.Worksheet.Range("E:M").EntireColumn.Hidden = True
End Sub

Open in new window

0
 
GPSPOWAuthor Commented:
Thanks

I will review the code and implement it for my user.

Glen
0
All Courses

From novice to tech pro — start learning today.