How to not copy the filtered data if it's empty or there is no data found?

Question

I am beginner in VBA. How can I ignore if the condition or the filtered table is empty then continue with other condition?

Here is the code I currently use:

   Sub Macro7()
    '
    ' Macro7 Macro
    '
     Dim LastRow As Long
    '
    Sheets("Ref2").Select
    ActiveSheet.Range("$A$1:$O$168").AutoFilter Field:=3, Criteria1:=Sheets("NOV 2022").Range("E1").Value
   ActiveSheet.Range("$A$1:$O$168").AutoFilter Field:=4, Criteria1:=Sheets("NOV 2022").Range("A6").Value
   LastRow = Range("E" & Rows.Count).End(xlUp).Row
   Range("E2:O" & LastRow).SpecialCells(xlCellTypeVisible).Select
   Selection.copy
   Sheets("NOV 2022").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
   ActiveWindow.SmallScroll Down:=21
   Sheets("Ref2").Select
   ActiveSheet.Range("$A$1:$O$168").AutoFilter Field:=4, Criteria1:=Sheets("NOV 2022").Range("A37").Value
   LastRow = Range("E" & Rows.Count).End(xlUp).Row
   Range("E2:O" & LastRow).SpecialCells(xlCellTypeVisible).Select
   Selection.copy
   Sheets("NOV 2022").Select
   Range("C37").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
   ActiveWindow.SmallScroll Down:=21
   Range("C58").Select
   Sheets("Ref2").Select
   ActiveSheet.Range("$A$1:$O$168").AutoFilter Field:=4, Criteria1:=Sheets("NOV 2022").Range("A58").Value
    LastRow = Range("E" & Rows.Count).End(xlUp).Row
    Range("E2:O" & LastRow).SpecialCells(xlCellTypeVisible).Select
   Selection.copy
   Sheets("NOV 2022").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
   ActiveWindow.SmallScroll Down:=27
   Range("C93").Select
   Sheets("Ref2").Select
   ActiveSheet.Range("$A$1:$O$168").AutoFilter Field:=4, Criteria1:=Sheets("NOV 2022").Range("A93").Value
   LastRow = Range("E" & Rows.Count).End(xlUp).Row
   Range("E2:O" & LastRow).SpecialCells(xlCellTypeVisible).Select
   Selection.copy
   Sheets("NOV 2022").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
  End Sub

You firstly must learn that selection/activation **only consume Excel resources, not bringing any benefit**... Besides that, your code looks primitive, no offence... Are you referring at the filter range **except headers**? You should use `Dim rng As Range` `LastRow = Range("E" & Rows.Count).End(xlUp).Row` before filtering. Then, use `On Error Resume Next` `Set rng = Range("E2:O" & LastRow).SpecialCells(xlCellTypeVisible)` followed by `On Error GoTo 0`. And check: `If Not rng Is Nothing then` and copy it... — FaneDuru, Nov 08 '22 at 12:46
You forgot the [link](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba)! @FaneDuru — Darren Bartrup-Cook, Nov 08 '22 at 14:52

VBasic2008 · Accepted Answer · 2023-02-01T21:16:41.163

Copy Filtered Data (Translating Macro-Recorder Code)

Option Explicit

Sub UpdateNov2022()
    
    Dim CriteriaAddresses() As Variant:
    CriteriaAddresses = VBA.Array("E1", "A6", "A37", "A58", "A93")
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("Ref2")
    If sws.AutoFilterMode Then sws.AutoFilterMode = False ' turn off AutoFilter
    
    Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion ' Table Range
    
    Dim scrg As Range ' Copy Range (no headers)
    With srg
        Set scrg = srg.Columns("E:O").Resize(.Rows.Count - 1).Offset(1)
    End With
    
    Dim dws As Worksheet: Set dws = wb.Worksheets("NOV 2022")
    
    Dim dcCell As Range ' Criteria Cell
    Dim CriteriaString As String
    
    Set dcCell = dws.Range(CriteriaAddresses(0))
    CriteriaString = CStr(dcCell.Value)
    srg.AutoFilter Field:=3, Criteria1:=CriteriaString
    
    Dim svrg As Range ' Visible Range (no headers)
    Dim dpCell As Range ' Paste Cell
    Dim n As Long
    
    For n = 1 To UBound(CriteriaAddresses)
        Set dcCell = dws.Range(CriteriaAddresses(n))
        CriteriaString = CStr(dcCell.Value)
        srg.AutoFilter Field:=4, Criteria1:=CriteriaString
        On Error Resume Next
            Set svrg = scrg.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        If Not svrg Is Nothing Then
            svrg.Copy
            Set dpCell = dws.Cells(dcCell.Row, "C")
            dpCell.PasteSpecial Paste:=xlPasteValues
            Set svrg = Nothing
        End If
    Next n
      
    Application.CutCopyMode = False
    sws.ShowAllData ' or to remove: sws.AutoFilterMode = False 
  
End Sub

How to not copy the filtered data if it's empty or there is no data found?

1 Answers1

Copy Filtered Data (Translating Macro-Recorder Code)