Jonathan
Jonathan

Reputation: 315

VBA, Adding Second Advanced Filter

I have a code for advanced filter a column for the workbook then put to a new sheet, my question is how do I add a second advanced filter for another column(Col A) for all worksheets and also populate to that new sheet. Here is my code

       Dim wks As Excel.Worksheet
       Dim wksSummary As Excel.Worksheet
         '------------------------------------------------------------------                ----------------
        'edited so it shows in the 3rd column row +1.  Add the header and                                 sheet name macro to this

    'has to have a column header to work. (aug 12)


   On Error Resume Next
   Set wksSummary = Excel.ActiveWorkbook.Worksheets("Unique data")
      On Error GoTo 0

    If wksSummary Is Nothing Then
Set wksSummary = Excel.ActiveWorkbook.Worksheets.Add
wksSummary.Name = "Unique data"
 End If


  'Iterate through all the worksheets, but skip [Summary] worksheet.
  For Each wks In Excel.ActiveWorkbook.Worksheets

     With wksSummary

    If wks.Name <> .Name Then
        If Application.WorksheetFunction.CountA(wks.Range("F:F")) Then
            Dim r As Range

 ' Get the first cell of our destination range... Change both col #'s to change col location
   Set r = .Cells(.Cells(.Rows.Count, 4).End(xlUp).Row + 1, 4)

 ' Perform the unique copy...
 If WorksheetFunction.CountA(wks.Range("F:F")) > 1 Then
   wks.Range("F:F").AdvancedFilter xlFilterCopy, , r, True
 Else
   r = "N/A"
 End If

' Remove the first cell at the destination range... Test without this next         line r.Delete xlShiftUp, remove it and get N/A.s



        End If

   r.Delete xlShiftUp

         End If

End With

 Next wks

Tried adding this but get an error

    'Iterate through all the worksheets, but skip [Summary] worksheet.
    For Each wks In Excel.ActiveWorkbook.Worksheets

With wksSummary

    'change the range values for which column u want to get advanced filter
    If wks.Name <> .Name Then
        If Application.WorksheetFunction.CountA(wks.Range("A:A")) Then
            Dim y As Range

 ' Get the first cell of our destination range... Change both col #'s to         change col location
   Set y = .Cells(.Cells(.Rows.Count, 4).End(xlUp).Row + 1, 5)

 ' Perform the unique copy...
 If WorksheetFunction.CountA(wks.Range("A:A")) > 1 Then
   wks.Range("A:A").AdvancedFilter xlFilterCopy, , r, True
 Else
   y = "N/A"
 End If

' Remove the first cell at the destination range... Test without this next line r.Delete xlShiftUp, remove it and get N/A.s



        End If

   r.Delete xlShiftUp

    End If

End With

 Next wks

I get an error on this line

     wks.Range("A:A").AdvancedFilter xlFilterCopy, , r, True

Upvotes: 0

Views: 178

Answers (1)

Jonas Korani
Jonas Korani

Reputation: 33

Check if your headers are the same as criteria in the advanced filter. Error 1004 might indicate that it is not.

Upvotes: 1

Related Questions