VBA script for adding new row with checkbox and delete button: Problems with naming shapes(?)

[Rogerstemsrudhagen]

The following script works fine for adding a first row, and deleting the same row after it is created. However, problems occur when adding consecutive rows.
What is the problem with this script? I suspect it has to do with the naming of the shapes (checkbox and delete button).
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim newRow As Range
Dim checkBox As Shape
Dim deleteButton As Shape
Dim checkBoxName As String
Dim deleteButtonName As String
Dim newRowNumber As Long ' Variable to keep track of the row number

' Set the worksheet where you want to insert the row
Set ws = ThisWorkbook.Sheets("Ark1")

' Insert a new row at row 5
Set newRow = ws.Rows(5).EntireRow
newRow.Insert Shift:=xlDown

' Set the formula for columns O, R, T, W, AB, AE, and AP
newRow.Cells(1, "O").FormulaR1C1 = "=TEXT(R[0]C[-1], ""ÅÅÅÅ"")"
newRow.Cells(1, "R").FormulaR1C1 = "=TEXT(R[0]C[-1], ""ÅÅÅÅ"")"
newRow.Cells(1, "T").FormulaR1C1 = "=TEXT(R[0]C[-1], ""ÅÅÅÅ"")"
newRow.Cells(1, "W").FormulaR1C1 = "=TEXT(R[0]C[-1], ""ÅÅÅÅ"")"
newRow.Cells(1, "AB").FormulaR1C1 = "=TEXT(R[0]C[-1], ""ÅÅÅÅ"")"
newRow.Cells(1, "AE").FormulaR1C1 = "=TEXT(R[0]C[-1], ""ÅÅÅÅ"")"
newRow.Cells(1, "AP").FormulaR1C1 = "=TEXT(R[0]C[-1], ""ÅÅÅÅ"")"

' Increment the newRowNumber variable to get a unique row number for naming
newRowNumber = newRow.Row

' Generate unique names for the checkbox and delete button based on the row number
checkBoxName = "CheckBox" & newRowNumber
deleteButtonName = "DeleteButton" & newRowNumber

' Add a single checkbox in column F of the newly created row
Set checkBox = ws.Shapes.AddFormControl(xlCheckBox, Left:=newRow.Cells(1, "F").Left + (newRow.Cells(1, "F").Width - 14) / 2, _
Top:=newRow.Cells(1, "F").Top + (newRow.Cells(1, "F").Height - 14) / 2, Width:=14, Height:=14)
checkBox.name = checkBoxName
checkBox.TextFrame.Characters.Text = vbNullString ' Set the text to an empty string

' Add a delete button in column G of the newly created row
Set deleteButton = ws.Shapes.AddFormControl(xlButtonControl, Left:=newRow.Cells(1, "G").Left, _
Top:=newRow.Cells(1, "G").Top, Width:=newRow.Cells(1, "G").Width, Height:=newRow.Cells(1, "G").Height)
deleteButton.name = deleteButtonName
deleteButton.TextFrame.Characters.Text = "Delete"
deleteButton.OnAction = "DeleteRowButton_Click"
End Sub

Sub DeleteRowButton_Click()
Dim btn As Button
Dim ws As Worksheet
Dim deleteRow As Long
Dim checkBoxName As String
Dim confirmation As VbMsgBoxResult

' Get the button that was clicked
Set btn = ActiveSheet.Buttons(Application.Caller)

' Get the row to delete from the button's name
deleteRow = Val(Right(btn.name, Len(btn.name) - Len("DeleteButton")))

' Set the worksheet where you want to delete the row
Set ws = ThisWorkbook.Sheets("Ark1")

' Get the name of the associated checkbox
checkBoxName = "CheckBox" & deleteRow

' Ask for confirmation before deleting
confirmation = MsgBox("Do you want to delete this record?", vbYesNo + vbExclamation, "Delete Record")

If confirmation = vbYes Then
' Delete the checkbox
On Error Resume Next
ws.Shapes(checkBoxName).Delete
On Error GoTo 0

' Delete the row
ws.Rows(deleteRow).Delete
End If
End Sub

 

[jkpieterse]

The issue is that if you insert a row, already present buttons and checkboxes move down. But their names still contain the old row number.
Instead of using the name to get the rownumber, you could use this to determine the position of the clicked button:

deleteRow = btn.TopLeftCell.row

With that, there is no need to change the control names.

 

[MartinMathiesen]

Did you get this VBA working? I’ve tried it but I’m quite new to VBA so I don’t understand what to change when it comes to the delete issue. Can you please explain in more detail?