VBA delete table row based on selection

[Chris Macro]

I want to make a macro that based on the cells selected, the macro will delete the table row (corresponding with the selected cell row). I would also like to show an error message if the selection is outside the table (we can call it table 1 for now). Here is what I have so far:

Error on:

x = .ListObject.ListRow.Index

Rest of Code:

<font face=Calibri><SPAN style="color:#00007F">Sub</SPAN> DeleteRow()<br><br><SPAN style="color:#00007F">Dim</SPAN> x <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br><br><SPAN style="color:#00007F">With</SPAN> Selection<br>    x = .ListObject.ListRow.Index<br>    .ListObject.ListRows(x).Delete<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[wigi]

Hello

Here's code for you:

Sub DeleteRow()

    Dim rng As Range
    
    On Error Resume Next
    With Selection.Cells(1)
        Set rng = Intersect(.EntireRow, ActiveCell.ListObject.DataBodyRange)
        On Error GoTo 0
        If rng Is Nothing Then
            MsgBox "Please select a valid table cell.", vbCritical
        Else
            rng.Delete xlShiftUp
        End If
    End With


End Sub

 

[Chris Macro]

Thank you so much Wigi. It worked perfectly!!!

 

[wigi]

You're welcome !

 

[Zack Barresse]

So this is a little interesting, because if you go by the Selection, it's possible that it could span multiple ranges, as well as multiple tables. If you assumed that it could only be contained in one table, and that those rows would be deleted, you would need quite a bit more code. Something like this would work...

Option Explicit

Sub RemoveSelectedTableRows()

    Dim loTtest         As ListObject
    Dim loSet           As ListObject
    Dim c               As Range
    Dim arrRows()       As Variant
    Dim arrTemp()       As Variant
    Dim xFind           As Variant
    Dim iCnt            As Long
    Dim sMsg            As String

    Erase arrRows()
    iCnt = 1
    For Each c In Selection.Cells
        If Not c.ListObject Is Nothing Then
            If loSet Is Nothing Then
                Set loSet = c.ListObject
            Else
                If c.ListObject <> loSet Then
                    'different table
                    MsgBox "You have more than one table selected.", vbInformation, "ERROR!"
                    GoTo MyExit
                End If
            End If

            If iCnt = 1 Then
                ReDim arrRows(1 To iCnt)
                arrRows(iCnt) = c.Row - loSet.HeaderRowRange.Row
                iCnt = iCnt + 1
            Else
                On Error Resume Next
                xFind = 0
                xFind = WorksheetFunction.Match(c.Row - loSet.HeaderRowRange.Row, arrRows(), 0)
                If xFind = 0 Then
                    ReDim Preserve arrRows(1 To iCnt)
                    arrRows(iCnt) = c.Row - loSet.HeaderRowRange.Row
                    iCnt = iCnt + 1
                End If
                Err.Clear
                On Error GoTo 0
            End If
        
        Else
            'a cell is not in a table
            MsgBox "Your selection is all or partially outside of a table.", vbInformation, "ERROR!"
            GoTo MyExit
        End If
    Next c

    Call SortArray(arrRows())
    sMsg = "Are you sure you want to delete " & UBound(arrRows) & " rows from '" & loSet.Name & "'?"
    If MsgBox(sMsg, vbYesNo + vbDefaultButton2, "CONTINUE?") <> vbYes Then Exit Sub
    
    For iCnt = UBound(arrRows) To LBound(arrRows) Step -1
        loSet.ListRows(arrRows(iCnt)).Delete
    Next iCnt

    Exit Sub

MyExit:

End Sub



Sub SortArray(MyArray() As Variant)

    Dim iStart          As Long
    Dim iEnd            As Long
    Dim iStep           As Long
    Dim iMove           As Long
    Dim vTemp           As Variant

    iStart = LBound(MyArray)
    iEnd = UBound(MyArray)
    For iStep = iStart To iEnd - 1
        For iMove = iStep + 1 To iEnd
            If MyArray(iStep) > MyArray(iMove) Then
                vTemp = MyArray(iMove)
                MyArray(iMove) = MyArray(iStep)
                MyArray(iStep) = vTemp
            End If
        Next iMove
    Next iStep

End Sub

It checks if more than one table is in the selection, also if the selection runs outside of the table, erroring on both of those conditions. Then it puts the selected (unique) rows into an array, sorts the array, then loops backwards through the array deleting the rows (checks with user first).

Edit: What this code does, as opposed to what was posted earlier, is take non-contiguous selected cells into account, in addition to the other conditions mentioned.

HTH

 

[wigi]

Nice work, Zack !

 

[MoDuL]

How can this be adapted to a userform based on combobox value?
I mean search combobox.value and delete the rows of the table?
Thank you in advance.

 

[BradleyRR]

Thanks Wigi, that worked great for me too.

I was looking for a way to remove only the filtered data from a table. I modified your code slightly and this worked for me:

            'Apply a filter, my example below
            ActiveSheet.ListObjects("YOURTABLE").Range.AutoFilter Field:=13, Criteria1:="="
            
            'Select only the visible cells (so you can delete them)
            ActiveSheet.ListObjects("YOURTABLE").DataBodyRange.SpecialCells(xlCellTypeVisible).Select
            
            On Error Resume Next
            With Selection.Cells(1)
                'Capture selected cells
                Set rng = Intersect(.EntireRow, ActiveCell.ListObject.DataBodyRange.SpecialCells(xlCellTypeVisible))
                
                'Remove filter
                ActiveSheet.ListObjects("YOURTABLE").Range.AutoFilter Field:=13
                
                'Remove only the filtered cells
                On Error GoTo 0
                If rng Is Nothing Then
                    MsgBox "Please select a valid table cell.", vbCritical
                Else
                    rng.Delete xlShiftUp
                End If
            End With

 

[Chris Macro]

I wanted to follow up on this, as people are continuing to comment. I just published code that I had been working to perfect since I first asked started this thread. The result is pretty darn close to mimicking the manual way of deleting/inserting table rows and is perfect if you need to protect your worksheet and still allow this functionality.

Here is my code: Insert & Delete Table Rows With Worksheet Protection

 

[IvanDIP]

I try to use the Zac Barresse CODE, but when it run It give an ERROR on this line:

loSet.ListRows(arrRows(iCnt)).Delete