excel - Delete button or hyperlink to each row of the excel table

Question

Can i insert a delete button(or hyperlink etc) to every excel table row so that user can delete that current row? Is it even possible with just single line of code like mine below? i can get the current row index to show in a cell but don't know how make that cell have something to click and pass to function with vba :)

I tried to find from microsoft documentation but delete method documentation wasn't helpful so far.

Sub Test()

Dim sheet As Worksheet
Dim list As ListObject
Dim row As ListRow

Set sheet = Sheets("Sheet1")
Set list = sheet.ListObjects(1)
Set row = list.ListRows.Add


row.Range(1, 1).Value = sheet.Range("C7").Value
row.Range(1, 2).Value = sheet.Range("C4").Value
row.Range(1, 3).Value = sheet.Range("C8").Value
row.Range(1, 4).Value = sheet.Range("C6").Value
row.Range(1, 5).Value = sheet.Range("C10").Value
row.Range(1, 6).Value = sheet.Range("C11").Value
row.Range(1, 7).Value = "Delete button" ' call deleteRow and pass id there

End Sub

Sub deleteRow(id)

Dim sheet As Worksheet

Set sheet = ActiveSheet
sheet.ListObjects("Table").ListRows(id).Delete

End Sub

标签： excel

Answer 1

Try this demo code, just paste into a new workbook and run the createTable macro. You should see a table with hyperlinks that delete the row. It may not be suitable for large tables though as it resizes the table and refreshes the links after every deletion.

     Dim objListObj As ListObject
     Dim objListRows As ListRows

     Sub createTable()
         ThisWorkbook.Sheets(1).ListObjects.Add(xlSrcRange, _
         Range("$A1:H10"), , xlNo).Name = "Table1"
         Call addLinks
     End Sub


     Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)

       If objListObj Is Nothing Then
         Set objListObj = ThisWorkbook.Sheets(1).ListObjects(1)
         Set objListRows = objListObj.ListRows
       End If

       ar = Split(Range(Target.SubAddress).Value, " ")
       MsgBox "Deleting Row " & ar(2)
       objListRows(ar(2)).Delete

       Dim newsize As Integer
       Let newsize = objListObj.Range.Rows.Count
       objListObj.Resize Range("A1:H" & newsize)
       Call addLinks

     End Sub

     Sub addLinks()

      Dim ws As Worksheet

      Set ws = ActiveWorkbook.Worksheets("Sheet1")
      Set objListObj = ws.ListObjects(1)
      Set objListRows = objListObj.ListRows
      Dim i As Integer, rng As Range

      For i = 1 To objListRows.Count
        Set rng = objListRows(i).Range.Columns(7)
        ws.Hyperlinks.Add Anchor:=rng, _
        Address:="", SubAddress:=rng.Address, _
        TextToDisplay:="Delete row " & i
      Next i

     End Sub