Using checkboxes to copy rows from one sheet to another in the same relative order

[ShammoAero]

Hi everyone,

I'm fairly new to VBA so this doesn't seem obvious to me at the moment.

My company is using a workbook where Sheet1 contains details of about 1000 documents, one on each row. Some of these documents are the "latest" versions and these have a check mark next to them, using checkboxes. We are trying to use Checkboxes to copy the rows that have a check mark from Sheet1 to Sheet2, where Sheet2 is meant to summarise these "latest" versions of the documents from Sheet1.
The problem is that if we insert a new row in Sheet1 somewhere in the middle of the worksheet and I insert a checkbox into that row which I then check mark, the row will be inserted as the LAST ROW of Sheet2. I need the row to be inserted in the same relative order as they appear in Sheet1.

Here is the code that I am currently using:

Sub Addcheckboxes()
Dim cell, LRow As Single
Dim chkbx As CheckBox
Dim CLeft, CTop, CHeight, CWidth As Double

Application.ScreenUpdating = False
LRow = ActiveSheet.Range("C" & Rows.Count).End(xlUp).Row

For cell = 3 To LRow
If Cells(cell, "A").Value <> "" Then
CLeft = Cells(cell, "E").Left
CTop = Cells(cell, "E").Top
CHeight = Cells(cell, "E").Height
CWidth = Cells(cell, "E").Width
ActiveSheet.CheckBoxes.Add(CLeft, CTop, CWidth, CHeight).Select
With Selection
.Caption = ""
.Value = xlOff
.Display3DShading = False
End With
End If
Next cell

Application.ScreenUpdating = True

End Sub


Sub RemoveCheckboxes()
Dim chkbx As CheckBox

For Each chkbx In ActiveSheet.CheckBoxes
chkbx.Delete
Next

End Sub


Sub CopyRows()

Sheets("sheet2").Range("A2:TX100000").ClearContents 'This ensures that entries aren't duplicated

For Each chkbx In ActiveSheet.CheckBoxes
If chkbx.Value = 1 Then
For r = 1 To Rows.Count
If Cells(r, 1).Top = chkbx.Top Then
With Worksheets("sheet2")

LRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & LRow & ":S" & LRow) = _
Worksheets("sheet1").Range("A" & r & ":S" & r).Value

End With
Exit For
End If
Next r
End If
Next

End Sub


This works well, until I need to add another row somewhere in the middle of sheet 1, which has a check mark. Then the row will be added at the end of sheet 2, instead of the order in which it appears in sheet1. The problem lies with the fact that Checkboxes are given an unique number which is in order of when they were placed in the sheet. If I remove all the checkboxes using the RemoveCheckboxes subroutine, then add them again using AddCheckboxes, then this will "solve" this problem but all the checkboxes will be cleared, and I have hundreds of checkboxes that will need to be checked again manually.

Does anyone have a solution to this problem?

Thank you very much.

[offthelip]

You can solve your problem by doing a double loop such as this ( Not tested)

Dim rowARRAY() As Integer
ReDim rowARRAY(1 To Rows.Count)




For Each chkbx In ActiveSheet.CheckBoxes
If chkbx.Value = 1 Then
For r = 1 To Rows.Count
If Cells(r, 1).Top = chkbx.Top Then
rowARRAY(r) = 1
Exit For
End if
next r
End If
Next




For r = 1 To Rows.Count
If rowARRAY(r) = 1 Then
With Worksheets("sheet2")


LRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & LRow & ":S" & LRow) = _
Worksheets("sheet1").Range("A" & r & ":S" & r).Value
End With
End If
Next r