If autofilter blank skip macro

[cizzett]

So I have been playing with If in my VBA, I have the below code that works perfect but I want to set an If function that will skip the section of code that opens and pastes data to my running file (I put lines sectioning the code I want to skip) if the autofilter does not have any data marked as "New"

Sub ExporttoDb()

        Application.DisplayAlerts = False
        Application.ScreenUpdating = False
        
   Dim Wbk As Workbook
   Dim Mws As Worksheet, Nws As Worksheet
   
   Set Mws = ThisWorkbook.Sheets("Today")
   
          ' Filter table to new records only
        With Mws.ListObjects("TodayTable").DataBodyRange
        .AutoFilter 2, "New"
        
   '-----------------------------------------------------------------------------------------
   
        ' Set and open file
        Set Wbk = Workbooks.Open(Mws.Range("R1").Value)
        Set Nws = Wbk.Sheets("Data")
        
        ' Paste Data to file
        Mws.ListObjects("TodayTable").DataBodyRange.Offset(1).SpecialCells(xlVisible).Copy
    Nws.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    
    ' Refresh's Pivot table data
   Worksheets("Pivot").Activate
   ActiveWorkbook.RefreshAll
      Wbk.Close True
      
    '----------------------------------------------------------------------------------------
      ' Clears Autofilter
     Mws.ShowAllData
     
      Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
   End With
End Sub

 

[Fluff]

Try

Sub ExporttoDb()

        Application.DisplayAlerts = False
        Application.ScreenUpdating = False
        
   Dim Wbk As Workbook
   Dim Mws As Worksheet, Nws As Worksheet
   
   Set Mws = ThisWorkbook.Sheets("Today")
   [COLOR=#ff0000]If Application.CountIf(Range("B:B"), "New") > 1 Then[/COLOR]
          ' Filter table to new records only
        With Mws.ListObjects("TodayTable").DataBodyRange
        .AutoFilter 2, "New"
        
   '-----------------------------------------------------------------------------------------
   
        ' Set and open file
        Set Wbk = Workbooks.Open(Mws.Range("R1").Value)
        Set Nws = Wbk.Sheets("Data")
        
        ' Paste Data to file
        Mws.ListObjects("TodayTable").DataBodyRange.Offset(1).SpecialCells(xlVisible).Copy
    Nws.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    
    ' Refresh's Pivot table data
   Worksheets("Pivot").Activate
   ActiveWorkbook.RefreshAll
      Wbk.Close True
    '----------------------------------------------------------------------------------------
      ' Clears Autofilter
     Mws.ShowAllData
   [COLOR=#ff0000]End If[/COLOR]
      Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
   End With
End Sub

Change the Range to suit

 

[cizzett]

Thanks for the assist but I actually figured it out

Sub ExporttoDb()

      Application.DisplayAlerts = False
        Application.ScreenUpdating = False
        
   Dim Wbk As Workbook
   Dim Mws As Worksheet, Nws As Worksheet
   
   Set Mws = ThisWorkbook.Sheets("Today")
   
          ' Filter table to new records only
        With Mws.ListObjects("TodayTable").DataBodyRange
        .AutoFilter 2, "New"
          If Mws.ListObjects("TodayTable").AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
   '-----------------------------------------------------------------------------------------
   
        ' Set and open file
        Set Wbk = Workbooks.Open(Mws.Range("R1").Value)
        Set Nws = Wbk.Sheets("Data")
        
        ' Paste Data to file
        Mws.ListObjects("TodayTable").DataBodyRange.Offset(1).SpecialCells(xlVisible).Copy
    Nws.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    
    ' Refresh's Pivot table data
   Worksheets("Pivot").Activate
   ActiveWorkbook.RefreshAll
      Wbk.Close True
    '----------------------------------------------------------------------------------------
       End If
    ' Clears Autofilter
    Mws.ShowAllData
      Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
   End With
End Sub

 

[Fluff]

Glad you sorted it & thanks for the feedback