Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 367
  • Last Modified:

Cut & Paste Filtered Data from one table to another

Hi Experts!

What is the cleanest way via VBA to filter on one column in a table and cut and paste the filtered result into a second table (identical) on a separate page?  The first table will no longer need those entries that's why I mentioned cut vs. copy.

Sample data attached.

Thanks for taking a look.
Cut-Paste-Filtered-Data.xls
0
xllvr
Asked:
xllvr
  • 8
  • 7
1 Solution
 
nutschCommented:
Try this code

Thomas

Sub asdfasd()

Dim lRowDest As Long

lRowDest = Sheets("Closed").Cells(Rows.Count, 2).End(xlUp).Row + 1

Application.DisplayAlerts = False

With Sheets("Active").[a4].CurrentRegion
    .AutoFilter
    .AutoFilter field:=9, Criteria1:="Closed"
    .Offset(1).SpecialCells(xlCellTypeVisible).Copy Sheets("Closed").Cells(lRowDest, 1)
    
    .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Delete
    .AutoFilter
End With

Application.DisplayAlerts = True

End Sub

Open in new window

0
 
xllvrAuthor Commented:
Thanks Thomas!  This works beautifully in my mock-up file.  Will test again in the real file after my next meeting.

Many thanks for the solution.
0
 
nutschCommented:
Glad to help.

Thomas
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
xllvrAuthor Commented:
Hi Thomas,

The code you wrote worked so beautifully in the mock up.  Any idea why it's failing in line 14 (below)?  The code winds up on the Active page but fails to delete the filtered rows and finish.  The real file I'm using (with some client data) is pretty simple, like the one I sent you.  Any idea why this would happen?

So sorry to chime back in on something I thought was closed out and done well.

.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Delete
0
 
nutschCommented:
do you also have a table in that file? It seems having a table complicates the delete process.

if you find the table name, try this after updating the Table1 part

listobject("Table1").databodyrange.SpecialCells(xlCellTypeVisible).delete

Thomas
0
 
xllvrAuthor Commented:
That's so interesting.  Both tabs had tables on them in the file I sent you and it worked fine.  I'll see if I can find the Table/List names.  They're not transparent like they are in later versions of Excel.  Once I find them, I'll give it a try.

Thank you so much!
0
 
xllvrAuthor Commented:
Or maybe I can just name the list as a named range.
0
 
xllvrAuthor Commented:
I tried it after naming the first table range Table1 and got a compile error "Sub or Function not defined".  Still looking to see if I can find what the lists/tables are really named.

Ugh...you did NOT sign up for this.
0
 
nutschCommented:
probably need to add an s to listobject

listobjects("Table1").databodyrange.SpecialCells(xlCellTypeVisible).delete
0
 
xllvrAuthor Commented:
Same error unfortunately.  It's interesting that it worked from my Excel 2010 saved down file but not in my work laptop which is 2003.
0
 
nutschCommented:
does the name of the table matter to yoU?
0
 
xllvrAuthor Commented:
Not really.  As long as it works, I'm good!
0
 
xllvrAuthor Commented:
Table 1 and Table 2 are fine (Active & Closed respectively).
0
 
nutschCommented:
Try this update

Sub asdfasd()

Dim lRowDest As Long, sLoName As String

lRowDest = Sheets("Closed").Cells(Rows.Count, 2).End(xlUp).Row + 1

Application.DisplayAlerts = False

With Sheets("Active").[a4].CurrentRegion
        
    If Application.WorksheetFunction.CountIf(.Columns(9), "Closed") > 0 Then
            
        With Sheets("Active").ListObjects(1)
            sLoName = .Name
            .Unlist
        End With
            
        .AutoFilter
        .AutoFilter field:=9, Criteria1:="Closed"
        .Offset(1).SpecialCells(xlCellTypeVisible).Copy Sheets("Closed").Cells(lRowDest, 1)
        
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilter
        
        Sheets("Active").ListObjects.Add(xlSrcRange, Range(.Address), , xlYes).Name = sLoName
    
    End If
    
End With

Application.DisplayAlerts = True

End Sub
                                            

Open in new window

0
 
nutschCommented:
Submitted correction to code above
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

  • 8
  • 7
Tackle projects and never again get stuck behind a technical roadblock.
Join Now