CODEWITHSUNDEEP
vbaexcel
Bluesector
Bluesector

Reputation: 329

Excel VBA - Autofilter (2 columns / 2 criteria) copies rows that don't match with the criteria

when I use the following VBA code:

With Range("A6:T" & lngLastRow)
    .AutoFilter
    .AutoFilter Field:=6, Criteria1:="Alexandra"
    .AutoFilter Field:=19, Criteria1:="-14"
    .Copy AlexSheet.Range("A3")
    .AutoFilter
End With

it copies rows that have the name "Alexandra" in autofilter field 6, but also copies 1 or 2 rows that have a different name and a different value in autofilter field 19 (not -14)

I don't know what causes Excel/VBA to copy rows I have never asked for.

I hope somebody can help me.

FULL CODE:

Sub DeleteFilterAndCopy()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Sheets("Alex").Range("A3:T1000").clearcontents
Sheets("Anett Edith").Range("A3:T1000").clearcontents
Sheets("Angela").Range("A3:T1000").clearcontents
Sheets("Dirk").Range("A3:T1000").clearcontents
Sheets("Daniel").Range("A3:T1000").clearcontents
Sheets("Klaus").Range("A3:T1000").clearcontents
Sheets("Konrad").Range("A3:T1000").clearcontents
Sheets("Marion").Range("A3:T1000").clearcontents
Sheets("MartinX").Range("A3:T1000").clearcontents
Sheets("Michael").Range("A3:T1000").clearcontents
Sheets("Mirko").Range("A3:T1000").clearcontents
Sheets("Nils").Range("A3:T1000").clearcontents
Sheets("Ulrike").Range("A3:T1000").clearcontents

Dim lngLastRow As Long
Dim AlexSheet As Worksheet, AnettEdithSheet As Worksheet, AngelaShett As Worksheet, DanielSheet As Worksheet
Dim DirkSheet As Worksheet, KlausSheet As Worksheet, Konradsheet As Worksheet
Dim MarionSheet As Worksheet, MartinSheet As Worksheet, MichaelSheet As Worksheet, MirkoSheet As Worksheet
Dim NilsSheet As Worksheet, Ulrikesheet As Worksheet

Set AlexSheet = Sheets("Alex")
Set AnettEdithSheet = Sheets("Anett Edith")
Set AngelaSheet = Sheets("Angela")
Set DanielSheet = Sheets("Daniel")
Set DirkSheet = Sheets("Dirk")
Set KlausSheet = Sheets("Klaus")
Set Konradsheet = Sheets("Konrad")
Set MarionSheet = Sheets("Marion")
Set MartinSheet = Sheets("MartinX")
Set MichaelSheet = Sheets("Michael")
Set MirkoSheet = Sheets("Mirko")
Set NilsSheet = Sheets("Nils")
Set Ulrikesheet = Sheets("Ulrike")

lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row

With Range("A6:T" & lngLastRow)
    .AutoFilter
    .AutoFilter Field:=6, Criteria1:="Alexandra"
    .AutoFilter Field:=19, Criteria1:="-14"
    .Copy AlexSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Anett / Edith"
    .Copy AnettEdithSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Angela"
    .Copy AngelaSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Daniel"
    .Copy DanielSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Dirk"
    .Copy DirkSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Klaus"
    .Copy KlausSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Konrad"
    .Copy Konradsheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Marion"
    .Copy MarionSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Martin"
    .Copy MartinSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Michael"
    .Copy MichaelSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Mirko"
    .Copy MirkoSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Nils"
    .Copy NilsSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Ulrike"
    .Copy Ulrikesheet.Range("A3")
    .AutoFilter
End With

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub

SCREENSHOTS OF DATA:

Data that gets filteres and copied from (orange columns = autofilter fields): enter image description here

The problem is, that the macro does not only copies rows which contain the Planner Alexandra and the value -14, it also copies 1-2 rows that have different values in both cells.

Greetings

Upvotes: 3

Views: 1201

Answers (3)

Takdir Madhavi
Takdir Madhavi

Reputation: 39

'For each new FilterCombinations criteria call this sub or modify according to your need
Sub Macro()
Range("A1").Select ''Assuming that 1st row is for header
ActiveCell.Offset(1, 0).Select

Dim intSpRowCount As Integer
intSpRowCount = Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Rows.count

If Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Rows.count > 1 Then
'copy only visible range
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(intSpRowCount - 1, Int(ActiveSheet.UsedRange.Rows.count) - 1)).Select
Selection.Copy

Sheets("Sheet3").Select
Range("A6").Select
ActiveSheet.Paste
End If
End Sub

Upvotes: 2

Anastasiya-Romanova 秀
Anastasiya-Romanova 秀

Reputation: 3368

Try this

With Range("A6:T" & lngLastRow)
    .AutoFilter Field:=6, Criteria1:="Alexandra"
    .AutoFilter Field:=19, Criteria1:="-14"
    .SpecialCells(xlCellTypeVisible).Copy AlexSheet.Range("A3")
End With

Upvotes: 4

Takdir Madhavi
Takdir Madhavi

Reputation: 39

     It's ? like how are you coping autofiltered data..
     Copy only special rows

     Range("A1").Select''Destination where want to paste
     'Use below code to paste
     Selection.PasteSpecial Paste:=xlPasteValue

Upvotes: 2

Related Questions