Check Boxes in Multiple Rows

Hi, I had a problem about like yours a few days ago, with the help from this board I came up with a solution. I modified the code below to do what you want. If you try to use check boxes you will have to link each box to a cell, this could take a lot of time, my solution was to format column A to Marlett, this will show a check mark when the letter “a” is used. The Marco will put a “check mark” in column A when you click in it, , and will remove it if you click it again. The other Marcos will clear the check marks and move your data, if you would like I will send you the workbook just E-mail me and let me know. This code assumes your data is in a sheet called sheet1 Hope this helps. Again I want to give thank for the help I got on this board for this project. Paul B.

Put this code in a Module
Sub Extract_Data()
'will copy a row from one worksheet, to a sheet called Selected Data
'IF Column A has an "a", "check mark" in it

'Variables used by the macro
Application.ScreenUpdating = False
Dim FilterCriteria
Dim NewFileName As String
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Selected Data").Delete
On Error GoTo 0
Sheets("Sheet1").Select

'Select the Range
'(note you can change this to meet your requirements)
Range("A1:B200").Select
'Apply Autofilter
Selection.AutoFilter
'FilterCriteria
FilterCriteria = "a"
'NOTE - this filter is on column A (field:=1), to change
'to a different column you need to change the field number
Selection.AutoFilter field:=1, Criteria1:=FilterCriteria
'Select the visible cells (the filtered data)
Selection.SpecialCells(xlCellTypeVisible).Select
'Copy the cells
Selection.Copy
'adds the new sheet
Sheets.Add
With ActiveSheet
.Name = "Selected Data"
' can be used to set column width
'Columns("B:B").Select
' Selection.ColumnWidth = 1.86
'Make sure you are in cell A1
Range("A1").Select
'Paste the copied cells
ActiveSheet.Paste
'Clear the clipboard contents
Application.CutCopyMode = False
With Selection
.WrapText = False
Range("A1").Select
'Go back Sheet1
'Clear the autofilter
Sheets("Sheet1").Select
Selection.AutoFilter field:=1
'Take the Autofilter off
Selection.AutoFilter
'Go to A1
Range("A1").Select
Range("A1") = "a"
Sheets("Selected Data").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End With
End With
End Sub

Sub clear_List()
Application.ScreenUpdating = False
Sheets("sheet1").Select
Range("a2:a200").Select
Selection.ClearContents
Sheets("Selected Data").Select
Columns("A:A").Select
Selection.ClearContents
Sheets("Sheet1").Select
Range("b2").Select
Application.ScreenUpdating = True
End Sub

Put this code in the sheet1 code
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range, cell As Range
If Selection.Cells.Count = 1 And _
Not Intersect(Selection, Columns(1)) Is Nothing And _
Not Intersect(Selection, ActiveSheet.UsedRange) Is Nothing Then
With Selection
If .Value = "a" Then
.ClearContents
Else: .Value = "a"
End If
End With
End If
End Sub

One more thing

The sheet that your data is moved to “selected data” will be replaced with a new one each time you run the Marco “Extract_Data”