Autofilter returns nothing but values are copied to new spreadsheet

StackOverflow https://stackoverflow.com/questions/23641784

  •  22-07-2023
  •  | 
  •  

Question

I'm having issues with the filter below. When the autofilter returns nothing (i.e. there are no result), it seems to copy across everything to the new spreadsheet that is generated. How can I prevent this from happening? I've tried inserting a check beforehand to see if there are any values after the filter but it keeps returning me an extraodinarily large number (when it should effectively be returning 2, as only the header rows A and B are visible).

With ThisWorkbook.Sheets("Master")

        .AutoFilterMode = False
        .Range("A2:Z2").AutoFilter Field:=refColumn, Criteria1:=itm
        .Range("A2:Z2").AutoFilter Field:=26, Criteria1:="Chase them to activate their token"

        ' Check to see if there are any values after the filter
        Dim FilterArea As Excel.Range
        Dim RowsCount As Long
        For Each FilterArea In ThisWorkbook.Sheets("Master").AutoFilter.Range.SpecialCells(xlCellTypeVisible)
            RowsCount = RowsCount + FilterArea.Rows.Count
        Next FilterArea

        ' If there are more than 2 rows then copy user id, first name last name to new spreadsheet
        If RowsCount > 2 Then
        .Range("A3:C" & LastRow).Copy
            ActiveWorkbook.Sheets("Sheet1").Range("A11").PasteSpecial xlPasteValues
        ' Copy and paste email
        .Range("E3:E" & LastRow).Copy
            ActiveWorkbook.Sheets("Sheet1").Range("D11").PasteSpecial xlPasteValues
        End If
    End With
Was it helpful?

Solution 2

Managed to figure it out by counting the number of visible rows:

With ThisWorkbook.Sheets("Master")
        .AutoFilterMode = False
        .Range("A2:Z2").AutoFilter Field:=refColumn, Criteria1:=itm
        .Range("A2:Z2").AutoFilter Field:=26, Criteria1:="Verify if the user is happy with the service and that everything works ok"

        ' If there are more than 1 rows then copy user id, first name last name
        Set VisibleRng = ThisWorkbook.Sheets("Master").AutoFilter.Range
        RowCount = VisibleRng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1

        If RowCount > 1 Then
        .Range("A3:C" & LastRow).Copy
            ActiveWorkbook.Sheets("Sheet1").Range("A" & NextHeaderRow + 4).PasteSpecial xlPasteValues
        ' Copy and paste email
        .Range("E3:E" & LastRow).Copy
            ActiveWorkbook.Sheets("Sheet1").Range("D" & NextHeaderRow + 4).PasteSpecial xlPasteValues
        End If
    End With

OTHER TIPS

In your code to copy stuff, you are using the variable lastrow which is not defined.

For what you are trying to achieve, it may make sense to have a look at the AdvancedFilter method.

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top