CODEWITHSUNDEEP
vbaexcel
Bart
Bart

Reputation: 55

Excel VBA AutoFilter adds empty rows

I have modified my Excel Macro, which before went row by row and it now filters the results and copies in bulk. Much more efficient.

The problem I encouter now, the Auto Filter adds Millions of empty rows to the Worksheet and I can't identify why it does so.

CountryCodes is a dictionary which contains the values for the filter. Criteria is looking for rows that contain the entry from the dictionary.

This is the code:

    For Each vall In CountryCodes
    thisWB.Activate
    thisWB.Sheets("Overall Numbers").Activate

    lookfor = CountryCodes.Item(vall)
    rep = Replace(thisWBName, "EMEA", lookfor)

    Set rng = ActiveSheet.Range("A1:Z1")

    FilterField = WorksheetFunction.Match("Host", rng.Rows(1), 0)

    If ActiveSheet.AutoFilterMode = False Then rng.AutoFilter

    rng.AutoFilter Field:=FilterField, Criteria1:="=*" & lookfor & "*", Operator:=xlFilterValues

    Set rng2 = ThisWorkbook.Worksheets("Overall Numbers").Cells.SpecialCells(xlCellTypeVisible)

    rng2.Copy Workbooks(rep).Worksheets("Overall Numbers").Range("A1")

    Workbooks(rep).Save

    thisWB.Activate
    thisWB.Sheets("Overall Numbers").Activate

    Cells.AutoFilter
Next

Upvotes: 3

Views: 216

Answers (2)

paul bica
paul bica

Reputation: 10715

Tested:

Dim ur As Range
Set ur = ThisWorkbook.Sheets("Overall Numbers").UsedRange

Application.ScreenUpdating = False
filterField = Application.Match("Host", ur.Rows(1), 0)
If Not IsError(filterField) Then

    For Each vall In countryCodes
       rep = Replace(thisWBName, "EMEA", vall)

       ur.AutoFilter Field:=filterField, Criteria1:="=*" & vall & "*"

       'copy visible rows with data only
       ur.SpecialCells(xlCellTypeVisible).Copy

       'paste visible rows with data only
       Workbooks(rep).Worksheets("Overall Numbers").Range("A1").PasteSpecial xlPasteAll
       Workbooks(rep).Save

       ur.AutoFilter
    Next
End If
Application.ScreenUpdating = True

Upvotes: 1

user4039065
user4039065

Reputation:

I've reorganized your code and removed the .Activate reliance and isolated the filtered data with the Range.CurrentRegion property.

With thisWB
    With .Worksheets("Overall Numbers")
        If .AutoFilterMode Then .AutoFilterMode = False

        lookfor = CountryCodes.Item(vall)
        rep = Replace(thisWBName, "EMEA", lookfor)

        With .Cells(1, 1).CurrentRegion
            FilterField = WorksheetFunction.Match("Host", .Rows(1), 0)
            For Each vall In CountryCodes
                .AutoFilter Field:=FilterField, Criteria1:="=*" & lookfor & "*", Operator:=xlFilterValues
                If CBool(Application.Subtotal(103, .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0))) Then
                    .Copy Workbooks(rep).Worksheets("Overall Numbers").Range("A1")
                    Workbooks(rep).Save
                End If
                .AutoFilter Field:=FilterField
            Next vall
        End With
    End With
    .AutoFilter
End With

Unless rep is somehow incremented, this appears to paste to the same workbook/worksheet/range for every iteration.

Upvotes: 1

Related Questions