CODEWITHSUNDEEP
vbaexcel
aicirtap
aicirtap

Reputation: 111

Filter and transfer to another sheet "NO CELLS WERE FOUND"

When i try to run this code without the DATE(which is last month) that is needed to be excluded there is an error says "NO CELLS WERE FOUND" I tried adding "else msgbox" but it is not functioning. Can someone please help me how to add another condition to my codes. Thanks 

Sub ExclusionDates()


    Dim sh As Worksheet, ws As Worksheet

    Set sh = Worksheets("Raw Data") 'set the sheet to filter
    Set ws = Worksheets("Exclusion") 'set the sheet to paste
    ws.Range("AD1", ws.Cells(ws.Rows.count, "A").End(xlUp)).clearcontents '<--| clear "paste" sheet columns A:L cells from row 1 down to column A last not empty one

'    Application.ScreenUpdating = False

    With sh '<--| reference your "copy" sheet
        With .Range("AD1", .Cells(.Rows.count, "A").End(xlUp)) '<--| reference its columns A:L cells from row 1 down to column A last not empty cell
                       .AutoFilter field:=10, Criteria1:=xlFilterLastMonth, Operator:=xlFilterDynamic

            If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then
            .SpecialCells(xlCellTypeVisible).Copy ws.Cells(ws.Rows.count, "A").End(xlUp).Offset(0) '<--| if any cell filtered other than headers (which get always filtered) then copy filtered values to "paste" sheet
            .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete '

        End If

                End With
        .AutoFilterMode = False
    End With

'    Application.ScreenUpdating = True

End Sub

Upvotes: 0

Views: 216

Answers (2)

DisplayName
DisplayName

Reputation: 13386

I think the flaw is in 

If Application.WorksheetFunction.Subtotal(103, .Cells) > 1

that would always return True since it'd check how many cells are visible in referenced range, which is some range spanning from columns A to AD, hence always returning at least 30 (the number of columns header)

so you may want to use

If Application.WorksheetFunction.Subtotal(103, .Columns(1)) > 1

here's the code with that correct line and the Else and some other comment adjusting

Option Explicit

Sub ExclusionDates()

    Dim sh As Worksheet, ws As Worksheet

    Set sh = Worksheets("Raw Data") 'set the sheet to filter
    Set ws = Worksheets("Exclusion") 'set the sheet to paste
    ws.Range("AD1", ws.Cells(ws.Rows.count, "A").End(xlUp)).ClearContents '<--| clear "paste" sheet columns A:L cells from row 1 down to column A last not empty one


    With sh '<--| reference your "copy" sheet
        With .Range("AD1", .Cells(.Rows.count, "A").End(xlUp)) '<--| reference its columns A:AD cells from row 1 down to column A last not empty cell
            .AutoFilter field:=10, Criteria1:=xlFilterLastMonth, Operator:=xlFilterDynamic
            If Application.WorksheetFunction.Subtotal(103, .Columns(1)) > 1 Then '<--| if any cell on column A filtered other than header (which gets always filtered)
                .SpecialCells(xlCellTypeVisible).Copy ws.Cells(ws.Rows.count, "A").End(xlUp).Offset(0) '<--| copy filtered values to "paste" sheet
                .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete ''<--| delete filtered values rows
            Else
                MsgBox "No Data found"
            End If
        End With
        .AutoFilterMode = False
    End With

End Sub

Upvotes: 2

QHarr
QHarr

Reputation: 84465

You could use error handling. Place On Error GoTo ErrHand just before line where you expect error to be thrown.

Option Explicit

Sub ExclusionDates()

    Dim sh As Worksheet, ws As Worksheet

    Set sh = Worksheets("Raw Data")              'set the sheet to filter
    Set ws = Worksheets("Exclusion")             'set the sheet to paste
    ws.Range("AD1", ws.Cells(ws.Rows.Count, "A").End(xlUp)).ClearContents '<--| clear "paste" sheet columns A:L cells from row 1 down to column A last not empty one

    '    Application.ScreenUpdating = False

    With sh                                      '<--| reference your "copy" sheet
        With .Range("AD1", .Cells(.Rows.Count, "A").End(xlUp)) '<--| reference its columns A:L cells from row 1 down to column A last not empty cell
            .AutoFilter field:=10, Criteria1:=xlFilterLastMonth, Operator:=xlFilterDynamic

            On Error GoTo ErrHand:
            If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then
                .SpecialCells(xlCellTypeVisible).Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(0) '<--| if any cell filtered other than headers (which get always filtered) then copy filtered values to "paste" sheet
                .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete '

            End If

        End With
        .AutoFilterMode = False
    End With

    '    Application.ScreenUpdating = True

    Exit Sub

ErrHand:

    If Err.Number = 1004 Then                    'could use 1004 here

        MsgBox "No cells found"
        Err.Clear
    Else
        Debug.Print Err.Description

    End If

End Sub

Upvotes: 1

Related Questions