VBA to copy filtered table data to the end of another table

Whittlebury

New Member
Joined
Apr 18, 2023
Messages
2
Office Version
  1. 365
Platform
  1. Windows
I'm trying to copy the 1st 3 columns of a filtered table to the bottom of another table on a different worksheet but only if any rows have been found.
The following works ok (but happy to know any better solutions) but I need to check if any filtered rows are found as otherwise it copies the entire table.
Many thanks

VBA Code:
Sub CopyNewFiles()
'
' CopyNewFiles Macro
'

'
    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    
    Dim lr As Variant
    Dim lo As ListObject
    
    Set wb = ActiveWorkbook
    Set ws1 = wb.Worksheets("link-report")
    Set ws2 = wb.Worksheets("PDF Xrefs")
    
    Application.ScreenUpdating = False
    
    ' Refresh the csv import table
    'wb.RefreshAll
    
    ' Filter any NEW pdfs
    ws1.ListObjects("link_report").Range.AutoFilter Field:=5, Criteria1:="NEW"
    
    'If the filtered table contains any rows Then [B]<< this condition is the bit I'm struggling with[/B]
    
        'Add empty row to the main table
        Set lr = ws2.ListObjects("PDF_Xref").ListRows.Add
        
        'Copy the 1st 3 columns of the filtered table
        ws1.ListObjects("link_report").ListColumns(1).DataBodyRange.Resize(, 3).Copy
        
        'Paste the input into the main table
        lr.Range.PasteSpecial xlPasteValues
    
    'End If
        
    'De-select the input data
    Application.CutCopyMode = False
    
End Sub
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
To check if there are any filtered rows, you can use the SpecialCells method with the xlCellTypeVisible constant. The following modification to your code will check if there are any visible rows in the filtered table before proceeding with the copy operation:
Code:

This code checks if there are any visible cells in the filtered table before copying and pasting the data. Additionally, it clears the filter at the end by using the ShowAllData method.
 
Upvote 0
VBA Code:
Sub CopyNewFiles()
    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet

    Dim lr As Variant
    Dim lo As ListObject

    Set wb = ActiveWorkbook
    Set ws1 = wb.Worksheets("link-report")
    Set ws2 = wb.Worksheets("PDF Xrefs")

    Application.ScreenUpdating = False

    ' Filter any NEW pdfs
    ws1.ListObjects("link_report").Range.AutoFilter Field:=5, Criteria1:="NEW"

    ' Check if any filtered rows are found
    On Error Resume Next
    Dim visibleCells As Range
    Set visibleCells = ws1.ListObjects("link_report").DataBodyRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    ' If the filtered table contains any rows
    If Not visibleCells Is Nothing Then

        ' Add empty row to the main table
        Set lr = ws2.ListObjects("PDF_Xref").ListRows.Add

        ' Copy the 1st 3 columns of the filtered table
        ws1.ListObjects("link_report").ListColumns(1).DataBodyRange.Resize(, 3).Copy

        ' Paste the input into the main table
        lr.Range.PasteSpecial xlPasteValues

    End If

    ' De-select the input data
    Application.CutCopyMode = False

    ' Clear the filter
    ws1.ListObjects("link_report").AutoFilter.ShowAllData

    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution
VBA Code:
Sub CopyNewFiles()
    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet

    Dim lr As Variant
    Dim lo As ListObject

    Set wb = ActiveWorkbook
    Set ws1 = wb.Worksheets("link-report")
    Set ws2 = wb.Worksheets("PDF Xrefs")

    Application.ScreenUpdating = False

    ' Filter any NEW pdfs
    ws1.ListObjects("link_report").Range.AutoFilter Field:=5, Criteria1:="NEW"

    ' Check if any filtered rows are found
    On Error Resume Next
    Dim visibleCells As Range
    Set visibleCells = ws1.ListObjects("link_report").DataBodyRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    ' If the filtered table contains any rows
    If Not visibleCells Is Nothing Then

        ' Add empty row to the main table
        Set lr = ws2.ListObjects("PDF_Xref").ListRows.Add

        ' Copy the 1st 3 columns of the filtered table
        ws1.ListObjects("link_report").ListColumns(1).DataBodyRange.Resize(, 3).Copy

        ' Paste the input into the main table
        lr.Range.PasteSpecial xlPasteValues

    End If

    ' De-select the input data
    Application.CutCopyMode = False

    ' Clear the filter
    ws1.ListObjects("link_report").AutoFilter.ShowAllData

    Application.ScreenUpdating = True
End Sub
That works fine for me. Thanks for the quick response!
 
Upvote 0

Forum statistics

Threads
1,223,098
Messages
6,170,106
Members
452,302
Latest member
TaMere

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top