Add and Remove Check Boxes with VBA

[Falko26]

Hi,

I have an Excel Table with an add and remove row button. Currently when these buttons are pressed the Check box is left in limbo. It doesn't copy down or get removed. Is there a way to add to my code that will add or remove the check boxes respectfully when the row is adjusted?

 'Add New Row to Table Individual Labor
Sub AddRowToTable_Equip_List()
    
    'Declare Variables
    Dim oSheetName As Worksheet
    Dim sTableName As String
    Dim loTable As ListObject
    
    ' Turn off Background Noise
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    'Define Variable
    sTableName = "Equip_List"
    
    'Define WorkSheet object
    Set oSheetName = Sheets("Equip List")
    
    'Define Table Object
    Set loTable = oSheetName.ListObjects(sTableName)
    
    'Add New row to the table
    loTable.ListRows.Add
      
    ' Turn Back On Background Noise
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub

'Remove Last Row from Table Individual Labor
Sub DeleteLastRow_Equip_List()
    
    ' Turn off Background Noise
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
        Dim Tbl As ListObject
Set Tbl = ActiveSheet.ListObjects("Equip_List")

' If table is down to last row do not delete Row
    If Tbl.DataBodyRange.Rows.Count = 1 Then Exit Sub
    
'If table has data in the description column do not delete row
Range("Equip_List[Equipment_Type]").Select
Selection.Cells(Selection.Rows.Count, 1).Select
    
    If IsEmpty(Selection) = False Then
    MsgBox "Row cannot be removed when Equipment_Type column is populated.", vbExclamation
    Exit Sub
    End If

Set Tbl = Nothing

' Delete Row
    With ActiveSheet.ListObjects("Equip_List").DataBodyRange
        ans = .Rows.Count
        .Rows(ans).delete
    End With
    
    ' Turn Back On Background Noise
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub

 

[John_w]

Add a new row. Replace:

    loTable.ListRows.Add

with:

    Dim newRow As ListRow
    Set newRow = loTable.ListRows.Add
    
    'Add checkbox in new row
    
    Dim cbCell As Range
    Dim cb As CheckBox
    Set cbCell = newRow.Range.Cells(1, loTable.ListColumns("Checkbox").Index)
    Set cb = oSheetName.CheckBoxes.Add(cbCell.Left + (cbCell.Width / 2), cbCell.Top, Width:=10, Height:=10)
    With cb
        .Caption = ""
        .Value = xlOff
    End With

Delete last row. Replace:

Set Tbl = Nothing

' Delete Row
    With ActiveSheet.ListObjects("Equip_List").DataBodyRange
        ans = .Rows.Count
        .Rows(ans).delete
    End With

with:

    ' Delete Row
    
    Dim lastRow As Long
    Dim cb As CheckBox
    With Tbl
        lastRow = .DataBodyRange.Rows.Count
        Set cb = Find_Checkbox_In_Cell(.DataBodyRange.Cells(lastRow, .ListColumns("Checkbox").Index))
        If Not cb Is Nothing Then cb.Delete
        .DataBodyRange.Rows(lastRow).Delete
    End With

and add this function:

Private Function Find_Checkbox_In_Cell(cell As Range) As CheckBox

    Dim cb As CheckBox
    
    For Each cb In cell.Worksheet.CheckBoxes
        If Not Intersect(cell, cb.TopLeftCell) Is Nothing Then
            Set Find_Checkbox_In_Cell = cb
            Exit For
        End If
    Next

End Function

Both changes assume the check box column is named "Checkbox" - change it in the above code as needed.

 

[Falko26]

Hey John,
Thanks for the Reply! Its much appreciated

The top bit of code that adds a check box when we add a row works perfectly.

The second part I'm having some troubles.

I wasn't sure where to place the Private Function so I just put it at the bottom of the page of code as shown below. Note All of this code lives in the Specific Sheet Code not a Module. Sheet Name = "WBS".

When I run the macro it makes it to this line then errors out.

Any Ideas??

Thanks again.

View attachment 64001

'Remove Last Row from Table Individual Labor
Sub BLC_DeleteLastRow_WBS()

    ' Turn off Background Noise
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
        Dim Tbl As ListObject
Set Tbl = ActiveSheet.ListObjects("Table8")

' If table is down to last row do not delete Row
    If Tbl.DataBodyRange.Rows.Count = 1 Then Exit Sub
    
'If table has data in the description column do not delete row
Range("Table8[WBS]").Select
Selection.Cells(Selection.Rows.Count, 1).Select
    
    If IsEmpty(Selection) = False Then
    MsgBox "Row cannot be removed when Description column is populated.", vbExclamation
    Exit Sub
    End If

Set Tbl = Nothing

    ' Delete Row
    Dim lastRow As Long
    Dim cb As CheckBox
    With Tbl
        lastRow = .DataBodyRange.Rows.Count
        Set cb = Find_Checkbox_In_Cell(.DataBodyRange.Cells(lastRow, .ListColumns("Checkbox").Index))
        If Not cb Is Nothing Then cb.Delete
        .DataBodyRange.Rows(lastRow).Delete
    End With
    
    ' Turn Back On Background Noise
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub

Private Function Find_Checkbox_In_Cell(cell As Range) As CheckBox

    Dim cb As CheckBox
    
    For Each cb In cell.Worksheet.CheckBoxes
        If Not Intersect(cell, cb.TopLeftCell) Is Nothing Then
            Set Find_Checkbox_In_Cell = cb
            Exit For
        End If
    Next

End Function

 

[Falko26]

John,

Ignore the above post. I figured it out, I still had the line of code: Set Tbl = Nothing on there so that's why I was getting the error.

Your original Post was Spot on!! Thanks again This has been a huge help!