If checkbox is checked then copy entire row to new tab

[2times]

Hi!

I've been searching this forum without finding the answer to my problem.

In my first tab (GEO-Export) I have a several rows with data. The Column A is filled with checkboxes on every row.

All I want to happen is that when a checkbox is checked, the entire row should be copied to a another tab (City) .
So if I check 10 checkboxes then 10 rows should appear in my second tab.
It's ok if I have to press a button after I have checked the boxes for the rows to be copied.

I found this code online but I cant get it to work

Sub CopyRows()
 
'Go through each check box in active sheet
For Each chkbx In ActiveSheet.CheckBoxes
     
    'If check box is enabled
    If chkbx.Value = 1 Then
 
        'Go through each row on worksheet
        For r = 1 To Rows.Count
 
            'Check if checkbox is on the same row
            If Cells(r, 1).Top = chkbx.Top Then
 
                'Simplify syntax
                With Worksheets("City")
 
                    'Identify the cell right below the last non empty cell
                    LRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
 
                    'Copy record from Sheet1 and paste to first empty row on Sheet2
                    .Range("A" & LRow & ":ND" & LRow) = _
                    Worksheets("GEO-Export").Range("B" & r & ":ND" & r).Value
                End With
                 
                'Exit For Loop
                Exit For
            End If
        Next r
    End If
Next
 
End Sub

Any help would be appreciated

[PCI]

It will be nice to send an Excel sample file to avoid to rebuild the layout for checking the macro
BTW you forgot the Code tags ...!

[2times]

I tried, but since I'm new to this forum I'm not allowed to put any links in my posts

[PCI]

See file attached

[2times]

Nice!

Attached you will find my document.
There are some other codes there as well but I think you will understand what I'm trying to do.

BTW the document is in Swedish so the tab Städer = City

Also if I press the button AddCB everything works fine when I press the button Copy.

But I need (I thnk) to have the checkboxes I put in manually because they are triggering some other codes that I need.


Thank You!

[PCI]

See how next code help: An update of your file attached

Option Explicit
Sub CopyRows()
Dim chkbx As CheckBox
Dim r  As Integer

    'Go through each check box in active sheet
    For Each chkbx In ActiveSheet.CheckBoxes
        'If check box is enabled
        If chkbx.Value = 1 Then
            'Go through each row in the used range
            For r = 1 To ActiveSheet.UsedRange.Rows.Count
                'Check if checkbox is on the same row
                If Cells(r, 1).Top = chkbx.Top Then
                    Rows(r).Copy Destination:=Worksheets("City").Cells(Rows.Count, "B").End(3)(2, 0)
                    Exit For
                End If
            Next r
        End If
    Next
End Sub

[2times]

PCI!

Thank you so much! Works almost perfect

One "last" question, is it poosible to skip to copy the first column? The one with the checkbox?
So start to copy the row from column B and then copy it to the other tab?

Again thank you!

[alansidman]

@2Times

Code Tags Added
Your post does not comply with Rule 2 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found at http://www.excelforum.com/forum-rule...rum-rules.html



(I have added them for you today. Please take a few minutes to read all Forum Rules and comply in the future.)

[2times]

Thank you alansidman, I will make sure to do it the right way next time.

[nigelog]

amended code and another method of addin checkboxes with link to row

Option Explicit
Sub CopyRows()
Dim chkbx As CheckBox
Dim r  As Integer
Dim lcol As Long
lcol = Cells(1, Columns.Count).End(xlToLeft).Column
    'Go through each check box in active sheet
    For Each chkbx In ActiveSheet.CheckBoxes
        'If check box is enabled
        If chkbx.Value = 1 Then
            'Go through each row in the used range
            For r = 1 To ActiveSheet.UsedRange.Rows.Count
                'Check if checkbox is on the same row
                If Cells(r, 1).Top = chkbx.Top Then
  Cells(r, 2).Resize(, lcol).Copy Destination:=Worksheets("City").Range("a" & Rows.Count).End(xlUp)(2)
                    Exit For
                End If
            Next r
        End If
    Next
End Sub
Public Sub chbox_forRows()
Dim Frow As Variant: Dim Lrow As Variant
Dim i As Long
Dim str As String
str = InputBox("Enter first and Last row separated by -")
Frow = InStr(str, "-")
Frow = Left(str, Frow - 1)
Lrow = Right(str, Len(str) - InStr(str, "-"))
'MsgBox "Add checkboxes from row " & Frow & " to " & Lrow
For i = Frow To Lrow
XAddCheckBoxes Cell:=Range("a" & i)
Next
End Sub
Private Sub XAddCheckBoxes(Cell As Range)
   With ActiveSheet.CheckBoxes.Add(Cell.Left, _
                                   Cell.Top, _
                                   Cell.Width, _
                                   Cell.Height)
      .LinkedCell = Cell.Offset(, 0).Address
      .Caption = Range(.LinkedCell).Row
   End With
End Sub

[PCI]

One "last" question, is it poosible to skip to copy the first column? The one with the checkbox?

See update

Option Explicit
Sub CopyRows()
Dim chkbx As CheckBox
Dim r  As Integer

    'Go through each check box in active sheet
    For Each chkbx In ActiveSheet.CheckBoxes
        'If check box is enabled
        If chkbx.Value = 1 Then
            'Go through each row in the used range
            For r = 1 To ActiveSheet.UsedRange.Rows.Count
                'Check if checkbox is on the same row
                If Cells(r, 1).Top = chkbx.Top Then
                    Range(Cells(r, 2), Cells(r, Columns.Count).End(xlToLeft)).Copy _
                     Destination:=Worksheets("City").Cells(Rows.Count, "A").End(3)(2)
                    Exit For
                End If
            Next r
        End If
    Next
End Sub

[2times]

PCI!

We are getting closer
I hope you understand how much this helps.

The only thin now that's missing is that in the tab with the checkboxes I have some cells with formulas. The cells with formulas in them are just empty in the City tab.

Any suggestions?

[PCI]

Is to paste only values good enought ???
If yes, see next code

Option Explicit
Sub CopyRows()
Dim chkbx As CheckBox
Dim r  As Integer

    'Go through each check box in active sheet
    For Each chkbx In ActiveSheet.CheckBoxes
        'If check box is enabled
        If chkbx.Value = 1 Then
            'Go through each row in the used range
            For r = 1 To ActiveSheet.UsedRange.Rows.Count
                'Check if checkbox is on the same row
                If Cells(r, 1).Top = chkbx.Top Then
                    Range(Cells(r, 2), Cells(r, Columns.Count).End(xlToLeft)).Copy
                    Worksheets("City").Cells(Rows.Count, "A").End(3)(2).PasteSpecial _
                     Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    Exit For
                End If
            Next r
        End If
    Next
End Sub

[2times]

PCI!

You are my hero, this is exactly what I was looking for.
Thank you so much for taking the time to help me.

If you ever are in Sweden I'm buying you a beer (or coffee)

[PCI]

Good news.
If you are please have a look on the reputation star at the bottom left