0

I am coding a userform to add, edit and delete data from a table located in the workbook. With the addition of a new row into the table, I give the row a unique number. When the user in the form double clicks in the Listbox (listbox contains the table from the sheet) on the line they want to remove. the data is being returned to the boxes inside the form(same as used to add data). The removal of the row relies on a unique number and uses that to search the table for the row to delete. that nr is then located in me.Nr when I try to add or delete the data it works mostly but it will error suddenly (no idea when the error occurred when it occurs). So it happens randomly, sometimes I can add or delete the whole listing in the table and sometimes it occurs just after adding or deleting a few rows.

For my lack of coding skills, it is very hard to say where the error occurss

the error is: -2147417848 Method "(delete or add) of object listrow failed

the error that is thrown up at delete code is here: lo.ListRows(rw).Delete

Error on add code is here: Set newrow = tbl.ListRows.Add(AlwaysInsert:=True)

When the errors are thrown up the sheet just crashes and the whole file crashes.

  1. I have tried putting [alwaysinstert:=True] at the end of Set newrow = ws.ListObjects("plandata").ListRows.Add
  2. Put every Private sub to normal Sub (Internet suggested that)

I cannot find more suggestions for fixing this error.

I appreciate any help or advice that you can give me, as I am new to VBA and trying to learn.

Thanks in advance,

Yede

Sub for Delete:

    Sub Deletebtn_Click()
    Dim lo As ListObject
    Dim cDelete As VbMsgBoxResult
    Dim num As Long
    Set lo = Sheets("Planningdata").ListObjects("Plandatag")
    
    'error statement
        On Error GoTo errHandler:
    'hold in memory and stop screen flicker
        Application.ScreenUpdating = False
    'check for values
        If Nr.Value = "" Or dagweek.Value = "" Then
            MsgBox "There is not data to delete"
        Exit Sub
        End If
    'give the user a chance to change their mind
        cDelete = MsgBox("Are you sure that you want to delete the data?", _
        vbYesNo + vbDefaultButton2, "Are you sure????")
        If cDelete = vbYes Then
    
            For cl = 1 To lo.HeaderRowRange.Count
                If lo.HeaderRowRange(cl) = "Nr" Then Exit For
            Next
    
                num = Me.Nr.Value
    
            For rw = lo.DataBodyRange.Rows.Count To 1 Step -1
                If lo.DataBodyRange(rw, cl) = num Then
                lo.ListRows(rw).Delete
            End If
        Next
        End If
        Application.ScreenUpdating = True
    Exit Sub
    errHandler:
    'show error information in a messagebox
    MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " & _
    Err.Number & vbCrLf & Err.Description & vbCrLf & "Please notify the administrator"
    End Sub

Sub for Save:

Sub Savebtn_Click()
Dim ws As Worksheet
Dim tbl As ListObject
Dim newrow As ListRow
Dim Last_row As Long

Application.EnableEvents = False

Set ws = Sheets("Planningdata")
Set tbl = ws.ListObjects("Plandatag")
On Error Resume Next
Set newrow = tbl.ListRows.Add(AlwaysInsert:=True)
On Error GoTo 0
DoEvents

Last_row = ws.Range("B10000").End(xlUp).Row
DoEvents

ws.Range("B" & Last_row) = "=ROW()-4"
ws.Range("C" & Last_row) = Me.Analyse.Value
ws.Range("D" & Last_row) = Me.dagweek.Value
ws.Range("E" & Last_row) = "=CONCAT(Plandatag[@Analyse],""-"",Plandatag[@Dag])"
ws.Range("F" & Last_row) = Me.Samplenr.Value
ws.Range("G" & Last_row) = Me.Apparaat.Value
DoEvents
Application.EnableEvents = True
Unload Me
Toevoegen.Show
End Sub
  • [Related Question](https://stackoverflow.com/questions/53012330/vba-listobject-wont-add-rows?rq=1)? – garbb Oct 19 '20 at 13:44
  • @garbb Thanks, I will look into that! – Sciurus Oct 19 '20 at 13:52
  • @garbb At this moment adding Planlist.Rowsource = "" right after the dim statements and adding the rowsource back when resetting the form keeps the errors away for now. i will test it very hard in the next weeks. Thanks for showing me that thread. cheers. – Sciurus Oct 26 '20 at 14:35

0 Answers0