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>

 

[IvanDIP]

I’m a beginner, an my English is very basic, so I hope you’ll forgive my simple way to express me and I hope you give suggestion to improve this code. I'm not a programmer, and with that I'm helping another person, so for me this is a challenge. I hope you can help me to help someone else.

HOW DELETE ROWS FROM A FILTERED TABLE
Every time I’m trying to delete one or more rows of a filtered table it returns an excel error message.
“This operation is not allowed. The operation is attempting to shift cells in a table on your worksheet.”

I tried to find a solution on internet but for my basic knowledge I wasn’t able to resolve this problem.
So I find a solution outflanking i!

1. If I can’t' delete a row from a filtered table, I taught: I have to delete them from a not filtered table!!! So first I replace a value of every row I want delete. So the various rows with different data, now they have a common data. (In my case in column “D” I replaced the existing data with a new value: “AAA” I decide replace with “AAA” because those rows will be at the beginning of the table and it could be essayer to find them.
2. Then remove the filters
3. So, with all data displayed we can select all data with the common value "AAA"
4. And finally we can delete them (because now we are not in a filtered table)!

I told you I’m a beginner so without any knowledge of VBA, so mixing different solution found on internet I realize that. (I’m sure there is a better way to write this code, or a simplest way to delete row from a filtered table, so I hope you can help me.

Sub AAA_DELET_ROWS_IN_A_FILTERED_TABLE()

    ActiveSheet.Unprotect
    Application.ScreenUpdating = False

    'This is a WIGI macro I modified
    Dim rng As Range
    On Error Resume Next
    With Selection.Cells
        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 "THIS IS THE PART OW WIGI CODE I REPLACED WITH"
            rng.Select
            Selection.Value = "AAA"
        End If
    End With

    ' Now we remove all filters
    ActiveSheet.ShowAllData

    ' Now we select all datas with "AAA"
    Dim rCell As Range
    Dim rRng As Range
    For Each rCell In Range("NAME_OF_A_RANGE")
        If rCell.Value = "AAA" Then
            If rRng Is Nothing Then
                Set rRng = rCell
            Else
                Set rRng = Application.Union(rRng, rCell)
            End If
        End If
    Next
    rRng.Select
    ' And finally we delete them.
    rRng.Delete xlShiftUp

    Application.ScreenUpdating = True
    ActiveSheet.Protect
End Sub

It works but I have a little problem, using this code of a Wigi MACRO
( * Set rng = Intersect(.EntireRow, ActiveCell.ListObject.DataBodyRange) )
when I replace the existing value with the new common one “AAA” it replace all cells of all selected rows.
And I need to replace with “AAA” just the “D” column of ALL SELECTED ROWS,
and not evry single cell of the selected rows.

Thanks for your attention.
Ivan

 

[phillfri]

If using structured tables, the following code will loop through a Selection (including a multi-range Selection) and delete table rows one at a time.

Sub DelTblRows()
    Dim TblName as string
    dim r as range
    Dim myTable as listobject
    Dim TblRowNo as long

    On Error Resume Next
    TblName = Selection.Cells(1, 1).ListObject.Name
    On Error GoTo ErrorHandler

    If Not IsEmpty(TblName) Then
        Set myTable = ActiveSheet.ListObjects(TblName)
        For Each r In Selection.Rows.EntireRow
            TblRowNo = R.Row - myTable.Databodyrange.Row + 1
            myTable.ListRows(TblRowNo).Delete
        Next
    Else
        MsgBox "Selection is not in a table."
    End If

ErrorHandler:

End Sub

 

[phillfri]

A "safer" version of my previous post. Not tested.

Sub DelTblRows()
    Dim TblName As String
    Dim r As Range
    Dim c As Range
    Dim myTable As ListObject
    Dim TblRowNo As Long
    Dim OutOfTable As Boolean

    On Error Resume Next
    TblName = Selection.ListObject.Name
    On Error GoTo ErrorHandler

    If Not IsEmpty(TblName) Then
        Set myTable = ActiveSheet.ListObjects(TblName)
        For Each r In Selection.Rows.EntireRow
            OutOfTable = False
            For Each c In r.Cells
                If Intersect(c, myTable.databodyrange) is Nothing Then
                    OutOfTable = True
                    MsgBox "This selected row (" & r.address & ") is not entirely within " & TblName & ". Deletion skipped."
                End If
            Next
            If Not OutOfTable Then
                TblRowNo = r.Row - myTable.DataBodyRange.Row + 1
                myTable.ListRows(TblRowNo).Delete
            End If
        Next
    Else
        MsgBox "Selection is not in a table."
    End If

ErrorHandler:

End Sub

 

[Zack Barresse]

Actually, you can do this without looping. Here is a function to remove all cells in the intersection of the selection and table [body]. Note it will only delete visible cells if the table is filtered, which behaves like Excel's default behavior.

Public Function DeleteTableSelectedRows( _
       ByVal Table As ListObject _
       ) As Long

    Dim SelectionRange As Range
    Dim SelectionArea As Range
    Dim DisplayAlerts As Boolean
    Dim DeleteRowsCount As Long

    DisplayAlerts = Application.DisplayAlerts
    
    On Error GoTo DeleteTableRows_Error
    
    Set SelectionRange = Intersect(Selection.EntireRow, Table.DataBodyRange.SpecialCells(xlCellTypeVisible))

    If Not SelectionRange Is Nothing Then
        For Each SelectionArea In SelectionRange.Areas
            DeleteRowsCount = DeleteRowsCount + SelectionArea.Rows.Count
        Next SelectionArea
        Application.DisplayAlerts = False
        SelectionRange.Delete
    End If
    
    DeleteTableSelectedRows = DeleteRowsCount
    
DeleteTableRows_Exit:
    Application.DisplayAlerts = DisplayAlerts
    Exit Function

DeleteTableRows_Error:
    DeleteTableSelectedRows = -1

End Function

Here is my regression test

Sub Regression_Reset()
    
    Dim Table As ListObject
    
    Set Table = ActiveSheet.ListObjects(1)
    
    On Error Resume Next
    Table.AutoFilter.ShowAllData
    On Error GoTo 0
    
    If Not Table.DataBodyRange Is Nothing Then Table.DataBodyRange.Delete
    Table.InsertRowRange(1, 1).Resize(9).Value = Application.Transpose(Array(1, 2, 3, 4, 5, 6, 7, 8, 9))
    Table.ListColumns(1).Range.AutoFilter 1, Array("1", "3", "5", "7", "9"), xlFilterValues
    Range("A4:A6,D6:A6,A8:B10").Select
    
End Sub


Sub Regression_DeleteTableRows_VisibleOnly()

    Regression_Reset
    
    Debug.Print DeleteTableSelectedRows(ActiveSheet.ListObjects(1))
    
    On Error Resume Next
    ActiveSheet.ListObjects(1).AutoFilter.ShowAllData
    On Error GoTo 0
    Range("A1").Select
    
End Sub

Testing code assumes there is a table on the active sheet. Please note it does delete the table and re-instantiate in order to test, so don't use it on an existing table.

HTH

 

[Ecallaw]

[QUOTE = wigi; 3384721] Olá

Aqui esta o código para rápido Você:

[código] Sub DeleteRow ()

rng Dim Como Faixa

On Error Resume Next
COM Selection.Cells (1)
Definir RNG = Intersecção (.EntireRow, ActiveCell.ListObject.DataBodyRange)
Em Erro GoTo 0
Se não for, então
MsgBox ", por favor , digite uma célula de tabela válida.", VbCritical
Else
rng.Delete xlShiftUp
End Se
End With


End Sub [/ code] [/ QUOTE]

Muito bom