Delete Unselected Rows of a Table

[MrBartlett]

Hi all,

I've been referencing this thread: https://www.mrexcel.com/forum/excel-...cted-rows.html

Specifically, this formula:

 	Sub KeepSelectedRows()
With Selection
OnErrorResumeNext
    Rows("1:" & .Row - 1).Delete
    Rows(.Row + .Rows.Count & ":" & Rows.Count).Delete
OnErrorGoTo 0
EndWith
EndSub

However, I just want to delete rows of a table, not entire rows of a sheet. I've been looking through Google for at least a good hour, and I can't find a solution for the exact use I have in mind.

Basically, I have a macro that pastes data in a table. But, in some cases, it may be updating a table that already has data, with more rows than are being pasted. For example, a table of 400 rows already has data in A1:A401. My macro pastes 300 rows in A1:A301. I want to delete those extra 100 rows that were not pasted/were already there. However, I just want to delete the table rows, not the sheet rows. Also ,when looking at the sheet after the macro pastes the data, it still has that pasted data selected. So, I figured a script that could remove all table rows underneath (if there is data underneath) would be the most elegant solution.

I've tried various formulas, even clearing table contents and resizing the table before the data is pasted. But, it slows everything down and usually ends up not loading.

Thanks in advance for any insights

 

[sirN]

SirN
Try this:

Sub Clear_Table_Rows()
'Modified  7/22/2018  11:18:37 PM  EDT
Application.ScreenUpdating = False
Dim ans As Long
    With ActiveSheet.ListObjects("Table1").DataBodyRange
        ans = .Rows.Count
        .Offset(1).Resize(ans - 1).Rows.Delete
    End With
Application.ScreenUpdating = True
End Sub

Works like a charm!!!! Thank you so much!!!!

 

[My Aswer Is This]

Works like a charm!!!! Thank you so much!!!!

Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.

 

[MrBartlett]

You can try this:
I never time my scripts but this may be fast.

Sub Filter_Me_Please()
'Modified  7/22/2018  11:51:55 PM  EDT
Application.ScreenUpdating = False
With ActiveSheet.ListObjects("Table1").DataBodyRange
    .AutoFilter 1
    ans = .Rows.Count
    If ans > 1 Then
    .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Delete
    End If
    .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

That looks like that will do, thanks!

In the meantime, this is everything I'm working on:

SuSub Paste_to_New_Table()
Application.ScreenUpdating = False
Application.Calculation = xlManual


'Delete all rows except for row 1 in KEYWORD GROUPING "main" table
With Worksheets("KEYWORD GROUPING").ListObjects("main").DataBodyRange
    .AutoFilter 1
    ans = .Rows.Count
    If ans > 1 Then
    .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Delete
    End If
    .AutoFilter
End With


'Unfilter all table columns & Calculate sheet
If Worksheets("KEYWORD LIST").FilterMode = True Then
Worksheets("KEYWORD LIST").ShowAllData
Worksheets("KEYWORD LIST").Calculate
End If


'Copy non-negatives into KEYWORD GROUPING sheet
Sheets("KEYWORD LIST").Select
ActiveSheet.Range("keywords_volume_list[#All]").RemoveDuplicates Columns:=2, _
        Header:=xlYes
    ActiveSheet.ListObjects("keywords_volume_list").Range.AutoFilter Field:=4, _
        Criteria1:="="

Range("B2:C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy _
Destination:=Range("main[[Paste Final Keywords]:[Volume]]")
        
       
'Resize table to accommodate data
    Dim Bottom As Long
Bottom = Range("main[[Paste Final Keywords]]").End(xlUp).Row
Worksheets("KEYWORD GROUPING").ListObjects("main").Resize Range("$A$3:$P" & Bottom)
End Sub

I can't get the last part to work...Basically, after the two columns are copied from table X, I want to paste them in table Y and resize table Y based on the last row.

Thanks for any insights!

 

[MrBartlett]

So, I tried a few variations of

'Resize table to accommodate data
    Dim Bottom As Long
Bottom = Range("main[[Paste Final Keywords]]").End(xlUp).Row
Worksheets("KEYWORD GROUPING").ListObjects("main").Resize Range("$A$3:$P" & Bottom)
End Sub

But to no avail. I think that somehow there may be an issue with how the preceding lines are introducing the data. Any ideas?

 

[MrBartlett]

Ended up getting something going. Now everything works great. Thanks

Dim ws As Worksheet
Dim ob As ListObject
Dim Lrow1 As Long


Lrow1 = Sheets("KEYWORD GROUPING").Cells(Rows.Count, "a").End(xlUp).Row
Set ws = ActiveWorkbook.Worksheets("KEYWORD GROUPING")
Set ob = ws.ListObjects("main")


ob.Resize ob.Range.Resize(Lrow1 - 1)