Reputation: 315
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
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