Loop through table row to create shape

[Beneindias]

Hey,

I bring another problem to you people.

I have some VBA code to check the last row of a certain table and create a checkbox in that row, if there are none.

Problem is, if a row is created in the midle of the table, no checkbox is created in this row, because it is only looking for the last row.

So, my code needs to be changed, so that it loops through all rows in the table, and creates a checkbox in every row, that does not have a checkbox in column B.

This is my code that checks if a Checkbox exists:

Public Function CheckBoxExists(ByVal Target As Range) As Boolean

    Dim ws As Worksheet
    Set ws = Target.Parent
    
    Dim chbx As CheckBox
    'Itera pelas Checkboxes existentes na folha
    For Each chbx In ws.CheckBoxes
        'Checa se existe Checkbox na linha
        If Not Intersect(chbx.TopLeftCell, Target) Is Nothing Then
            'Existe Checkbox na linha
            CheckBoxExists = True
            Exit Function
        End If
    'Passa para a próxima Checkbox
    Next chbx
    
    'Não existe Checkbox
    CheckBoxExists = False
    
End Function

This is the code that creates the checkbox:

Sub Checkboxes_Creation()
    Dim lastRow As Long
    Dim Sh As Worksheet
    Dim worksheet1 As String: worksheet1 = "Salarios" 'Salarios
    Dim PagoColumn As String: PagoColumn = "B"
    Dim StatusColumn As String: StatusColumn = "C"
    Dim LastRowColumn As String: LastRowColumn = "l:l" 'Include Entire Column.
    Dim HRnumber As Integer
     
        Set Sh = ActiveSheet
     
        With Sh
            'Número da última coluna da tabela
            lastRow = WorksheetFunction.CountA(Range(LastRowColumn))
        End With
        'Checa se não há nenhuma checkbox na linha. O "+7", serve para ignorar as 7 linhas antes da tabela
        '(não consegui fazer com que adicionasse a checkbox na linha X da tabela, pelo que tive que fazer X + 7)
        If Not CheckBoxExists(Sh.Range(PagoColumn & lastRow + 7)) Then
            With Sh.Range(PagoColumn & lastRow)
                'Criação da checkbox e suas definições
                With Sh.CheckBoxes.Add(Cells(lastRow, PagoColumn).Left, Cells(lastRow + 7, PagoColumn).Top, 10, 10)
                    .Caption = ""
                    .Locked = False
                    .LockedText = False
                    .Value = xlOff
                    .LinkedCell = Cells(lastRow + 7, StatusColumn).Address
                End With
                'Chama o código para centrar a Checkbox na célula
                Call CenterCheckbox
            End With
        End If
End Sub

I'm trying to add a "for each" loop, so the code loops by every row, but I wasn't able to do that yet.

Can anybodu help me with this, as I don't have much free time to have this file ready to be used in my company.

Another thing, I have that "lastRow + 7", because my table starts in row 7. Can this be done without this part? because if someone adds a row before the table, this code will break.

Cheers

 

[Beneindias]

Ok, so, I made progress.
The creation and deletion of the checkboxes is almost working as intended.

Code is already looping through table's rows and creating checkbox even when a row is added in the midle of the table.
Now, my problem is that, sometimes, when I delete a row in the middle of the table, that checkbox is not deleted and I end up with two checkboxes in that row.

I think that probably the problem is that my code to delete checkboxes loops through all checkboxes and deletes every checkbox that is after my last row.
When I delete a row in the middle of the table, all the other checkboxes go up with the rows, and the checkbox that was in the deleted row, stays in the same place, so, for example, if I delete row 10, I end up with checkbox of row 10 and row 11 in the same cell in the new row number 10.

But then, after this, if I insert a new row in the table (bottom or middle, doesn't matter), the checkboxes will fix themselves and I end up with only one checkbox per row.

I don't know if I'm explaining this very well, but I can try and explain it better.

I was toying with the idea of having an extra If to check if checkbox has any linked cell.
(assuming that if I delete that row, the checkbox does not have a linked cell anymore)

Any way to solve this, or will I need to live with this?


Code to check if Checkbox exists in that row:

Public Function CheckBoxExists(ByVal Target As Range) As Boolean

    Dim ws As Worksheet
    Set ws = Target.Parent
    
    Dim chbx As CheckBox
    'Itera pelas Checkboxes existentes na folha
    For Each chbx In ws.CheckBoxes
        'Checa se existe Checkbox na linha
        If Not Intersect(chbx.TopLeftCell, Target) Is Nothing Then
            'Existe Checkbox na linha
            CheckBoxExists = True
            Exit Function
        End If
    'Passa para a próxima Checkbox
    Next chbx
    
    'Não existe Checkbox
    CheckBoxExists = False
    
End Function

New code to loop for each table row and create checkbox:

Sub Checkboxes_Creation()
    Dim lastRow As Long
    Dim Sh As Worksheet
    Dim worksheet1 As String: worksheet1 = "Salarios" 'Salarios
    Dim PagoColumn As String: PagoColumn = "B"
    Dim StatusColumn As String: StatusColumn = "C"
    Dim LastRowColumn As String: LastRowColumn = "l:l" 'Include Entire Column.
    Dim HRnumber As Integer
    Dim table As ListObject
    Dim tableData, rowData As Range
    Dim countA As Integer
    
     
    Set Sh = ActiveSheet
    Set table = Sh.ListObjects("TabelaSalarios")
    Set tableData = table.DataBodyRange
        
    countA = 0
    
        With Sh
            'Número da última coluna da tabela
            lastRow = WorksheetFunction.countA(Range(LastRowColumn))
        End With
        
    For Each rowData In tableData.Rows
        'Checa se não há nenhuma checkbox na linha. O "+7", serve para ignorar as 7 linhas antes da tabela
        '(não consegui fazer com que adicionasse a checkbox na linha X da tabela, pelo que tive que fazer X + 7)
        If Not CheckBoxExists(Sh.Range(PagoColumn & rowData.Row)) Then
            With Sh.Range(PagoColumn & rowData.Row)
                'Criação da checkbox e suas definições
                With Sh.CheckBoxes.Add(Cells(rowData.Row, PagoColumn).Left, Cells(rowData.Row, PagoColumn).Top, 10, 10)
                    .Caption = ""
                    .Locked = False
                    .LockedText = False
                    .Value = xlOff
                    .LinkedCell = Cells(rowData.Row, StatusColumn).Address
                End With
                'Chama o código para centrar a Checkbox na célula
                Call CenterCheckbox
            End With
        End If
        countA = countA + 1
    Next
End Sub

Code that loopes through all checkboxes and deletes them if they are after my last row:

Sub Checkboxes_Deletion()
    Dim lastRow As Long
    Dim Sh As Worksheet
    Dim worksheet1 As String: worksheet1 = "Salarios" 'Salarios
    Dim PagoColumn As String: PagoColumn = "B"
    Dim LastRowColumn As String: LastRowColumn = "l:l" 'Include Entire Column.
    Dim Cbx As CheckBox
     
           Set Sh = ActiveSheet
        
        With Sh
            'Número da última linha da tabela
            lastRow = WorksheetFunction.countA(Range(LastRowColumn))
        End With
    
        'Itera pelas Checkboxes da folha
        For Each Cbx In ActiveSheet.CheckBoxes
            'Checa se o espaço não está ocupado por uma checkbox. "lastRow + 8" para que seja considerada a linha após o fim da tabela
            If Not Intersect(Cbx.TopLeftCell, ActiveSheet.Range(PagoColumn & lastRow + 8)) Is Nothing Then
                'Apaga a Checkbox, se esta estiver na linha após a tabela
                Cbx.Delete
            End If
        Next Cbx
End Sub

Thanks to all who can help me fix this mess