Checkbox problems

[randomdrums]

Hi all, new forum member here so please be kind and let me know if ever I haven't posted in the right place or the right thing.

I am having problems with checkboxes in a very large Workbook that involves multiple sheets and what not, but I will try to be as precise as possible.

This particular worksheet is an Invoice register, which has a few columns and that automatically get added via another macro directly from my Invoice Template sheet. At the end of each row of data, I have setup a checkbox. The idea is that when the invoice is paid, the checkbox gets clicked and the infomation in that invoice's row get put into a table in another worksheet, making it easy to keep track of what has been paid or not, and then have the "Transactions" page calculate all my tax and income tax stuff (which already contains huge amounts of formulas and other information).
After writing it all out, I get a Run-Time Error 1004 on the couloured line and I'm not sure how to fix it. Any help would be appreciated.

Here is the VBA code for said Macro, and I will also include a screenshot of the sourceSheet and targetSheet as well. I will also note that each Checkbox is cell linked to the cell is it in/on, but the TRUE or FALSE statement is just hidden by making the text white.

Sub TransferDataToTransactions()

    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim nextFreeRow As Long
    Dim dataToCopy As Variant
    Dim i As Long
    Dim lastRow As Long
    Dim currentRow As Long
    Dim chkBox As CheckBox
    
    Set sourceSheet = ThisWorkbook.Sheets("Invoice Record") ' Change to your source sheet name
    Set targetSheet = ThisWorkbook.Sheets("Transactions") ' Change to your target sheet name
    
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "B").End(xlUp).Row
    
    For i = 1 To lastRow
[COLOR=rgb(250, 197, 28)]        Set chkBox = sourceSheet.CheckBoxes("CheckBox" & i)[/COLOR]
        If chkBox.Value = 1 Then
        dataToCopy = Array(sourceSheet.Cells(i, "B").Value, sourceSheet.Cells(i, "C").Value, sourceSheet.Cells(i, "D").Value, sourceSheet.Cells(i, "E").Value)
            
            ' Find the next free row in the target sheet's table
            nextFreeRow = targetSheet.ListObjects("TransactionTable").ListRows.Count + 1 ' Change "TransactionTable" to your table name
            
            ' Copy data to the next free row in the target sheet
            targetSheet.ListObjects("TransactionTable").ListRows.Add
            targetSheet.Cells(nextFreeRow, 1).Value = Date
            targetSheet.Cells(nextFreeRow, 2).Value = dataToCopy(0)
            targetSheet.Cells(nextFreeRow, 3).Value = dataToCopy(1)
            targetSheet.Cells(nextFreeRow, 5).Value = dataToCopy(2)
            targetSheet.Cells(nextFreeRow, 6).Value = dataToCopy(3)
            
            ' Sort after each row is added
            ActiveWorkbook.Worksheets("Transactions").ListObjects("TransactionTable").Sort. _
                SortFields.Clear
            ActiveWorkbook.Worksheets("Transactions").ListObjects("TransactionTable").Sort. _
                SortFields.Add2 Key:=Range("TransactionTable[[#All],[AAAA-MM-DD]]"), SortOn _
                :=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            With ActiveWorkbook.Worksheets("Transactions").ListObjects("TransactionTable"). _
                Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End If
    Next i

End Sub

 

[MikeVol]

Ok randomdrums, Delete all your controls (Check Box) from the Invoice Record sheet and paste the following code into the module of this sheet (Invoice Record).

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub

    If Not Intersect(Target, Me.Range("F2:F" & Me.Cells(Me.Rows.Count, "B").End(xlUp).Row)) Is Nothing Then
        Target.Font.Name = "Marlett"

        Dim tbl     As ListObject
        Set tbl = ThisWorkbook.Worksheets("Transactions").ListObjects("TransactionTable")

        If Target = "a" Then
            Target = ""

            Dim foundRow As Range
            Set foundRow = tbl.DataBodyRange.Columns(2).Find(What:=Cells(Target.Row, 2).Value, LookIn:=xlValues, LookAt:=xlWhole)

            If Not foundRow Is Nothing Then
                tbl.ListRows(foundRow.Row - tbl.DataBodyRange.Row + 1).Delete
                Set foundRow = Nothing
            End If

        Else
            Target = "a"

            Dim newRow As ListRow
            Set newRow = tbl.ListRows.Add(AlwaysInsert:=True)

            With newRow.Range
                .Cells(1) = Date
                .Cells(2) = Cells(Target.Row, 2)
                .Cells(3) = Cells(Target.Row, 3)
                .Cells(5) = Cells(Target.Row, 4)
                .Cells(6) = Cells(Target.Row, 5)
            End With

            Set newRow = Nothing
        End If

        Target.Offset(0, 1).Activate
        Set tbl = Nothing
    End If

End Sub

Now, click in the cell in the column (Paid) F a check mark will appear and this row will be copied to the Transactions sheet. If you click on the check mark again, it will disappear and this row with data will be deleted on the Transactions sheet. Good luck.

 

[dmt32]

Hi

Not tested but based on information you have provided, see if the following update to your code will do what you want.

Sub TransferDataToTransactions()
    Dim ChkBox              As CheckBox
    Dim tblTransactions     As ListObject
    Dim NewTransactions     As ListRow
    Dim rngCopy             As Range, rngPaid As Range
    Dim wsInvoice           As Worksheet, wsTransactions As Worksheet
    
    On Error GoTo myerror
    With ThisWorkbook
        Set wsInvoice = .Worksheets("Invoice Record")
        Set wsTransactions = .Worksheets("Transactions")
    End With
    
    Set tblTransactions = wsTransactions.ListObjects(1)
    
    For Each ChkBox In wsInvoice.CheckBoxes
        
        If ChkBox = xlOn Then
        
            Set rngCopy = wsInvoice.Cells(ChkBox.TopLeftCell.Row, 1).Resize(, 5)
            
            If rngPaid Is Nothing Then
                Set rngPaid = rngCopy
            Else
                Set rngPaid = Union(rngCopy, rngPaid)
            End If
            
        End If
        
        Set rngCopy = Nothing
        
    Next ChkBox
    
    If Not rngPaid Is Nothing Then
        
        Set NewTransactions = tblTransactions.ListRows.Add(AlwaysInsert:=True)
        
        rngPaid.Copy NewTransactions.Range
        
    End If
    
    'your sort code
    
myerror:
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
    
End Sub

Code follows similar suggestion made by @kevin9999 to loop though all checkbox object in the invoice sheet negating the need to specify the name in the code.

For all checkboxes whose value = xlOn (1) the range(s) are combined into one range using the union method which allows the copying process to be completed in one go which should prove to be faster.

HOWEVER – there is a problem in that the code each time it is run, will copy ALL records whose checkbox = xlon creating duplicates in the Transactions table.

I suggest that you include a column to add invoice number which allow you to check if an invoice exists in said table before it is marked for copying.


If solution however, does not do what you want then to help forum members, please provide copy of your workbook (with dummy data) using a file sharing site like dropbox & provide a link to it here.

Happy New Year

Dave

 

[randomdrums]

Thanks to all for the help. But it would seem that I got it to do what I wanted to in the end, and I also added a section of Duplicate checking. Here is the final code that I used.

Sub TransferDataToTransactions()

    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    Dim dataToCopy As Variant
    Dim i As Long
    Dim chkBox As CheckBox
    Dim alreadyExists As Boolean
    Dim cell As Range
    Dim transactionTable As ListObject
    
    Set sourceSheet = ThisWorkbook.Sheets("Invoice Record") ' Change to your source sheet name
    Set targetSheet = ThisWorkbook.Sheets("Transactions") ' Change to your target sheet name
    Set transactionTable = targetSheet.ListObjects("TransactionTable") ' Change "TransactionTable" to your table name
    
    For Each chkBox In sourceSheet.CheckBoxes
        If chkBox.Value = 1 Then
            i = chkBox.TopLeftCell.Row
            dataToCopy = Array(sourceSheet.Cells(i, "B").Value, sourceSheet.Cells(i, "C").Value, sourceSheet.Cells(i, "D").Value, sourceSheet.Cells(i, "E").Value)
            
            ' Check if the data already exists in the target sheet
            alreadyExists = False
            For Each cell In transactionTable.ListColumns(2).DataBodyRange
                If cell.Value = dataToCopy(0) Then
                    alreadyExists = True
                    Exit For
                End If
            Next cell
            
            If Not alreadyExists Then
                ' Find the last row in the target sheet's table
                lastRow = transactionTable.ListRows.Count
                
                ' Copy data to the last row in the target sheet
                transactionTable.DataBodyRange(lastRow, 1).Value = Date
                transactionTable.DataBodyRange(lastRow, 2).Value = dataToCopy(0)
                transactionTable.DataBodyRange(lastRow, 3).Value = dataToCopy(1)
                transactionTable.DataBodyRange(lastRow, 5).Value = dataToCopy(2)
                transactionTable.DataBodyRange(lastRow, 6).Value = dataToCopy(3)
                
                ' Sort after each row is added
                transactionTable.Sort.SortFields.Clear
                transactionTable.Sort.SortFields.Add2 Key:=transactionTable.ListColumns("AAAA-MM-DD").Range, SortOn _
                    :=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
                With transactionTable.Sort
                    .Header = xlYes
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            End If
        End If
    Next chkBox

End Sub