CheckBox Array . . . . I think?

[kotting]

I have a worksheet where information from inputboxes from another sheet is deposited. I have arranged the information into nice neat rows. The problem is:

I want a checkbox on each row to strikeout the text on that row if the checkbox on that row is 'checked'. There are 365 rows on this worksheet in use. The solution I have requires that each checkbox 'code area' be filled with - (something along the lines of

If text is strikeout = true then strikeout =false

else strikeout = true

this works but I have to write a macro for each Checkbox for each row. Is there a way to do this without having to write 365 macros?
Thanks

 

[Joe Was]

"X" [case sensitive] is the trigger for the copy, if column "A" of that row has a "X" it gets copied. Once copied the "X" is converted to a "*" to let you know what got pasted!

Otherwise, I don't understand your question?
What does B2 have to do with A1?
If A2 is not marked with an "X" it does not get copied.

 

[atomicluis]

Sorry I meant A2,

If the source sheet contains data on B2:B5, and "X"s on A2:A5.
Data on B2:B5 should get copied since they all have an "X" on column A.
But after running the macro only the data from B5 get copied.

Now, If I also include data on C2:C5, then everything get copied.

thanks.

This is what i am using:

Sub Priority()
Application.ScreenUpdating = False
Worksheets("Sheet2").Select
For Each r In Worksheets("Sheet2").UsedRange.Rows
n = r.Row
If Worksheets("Sheet2").Cells(n, 1) = "X" Then
Worksheets("Sheet2").Range(Cells(n, 2), Cells(n, 7)).Copy _
Destination:=Worksheets("Sheet1").Range("B65536").End(xlUp).Offset(1, -1)
Else
End If
Next r

Worksheets("Sheet2").Columns("A").Replace What:="X", Replacement:="*", _
SearchOrder:=xlByColumns, MatchCase:=True

Application.CutCopyMode = True
Application.ScreenUpdating = True

End Sub

 

[Joe Was]

I tested this and repaired the code based upon your posted revisions. It should now work for you:

Sub Priority()
Dim myRange As Range, myBot&

Application.ScreenUpdating = False
Worksheets("Sheet2").Select
myBot = Range("A65536").End(xlUp).Row
Set myRng = Range(Cells(1, 1), Cells(myBot, 1))

For Each r In myRng
n = r.Row
If Worksheets("Sheet2").Cells(n, 1) = "X" Then
Worksheets("Sheet2").Range(Cells(n, 2), Cells(n, 7)).Copy _
Destination:=Worksheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0)
Else
End If
Next r

Worksheets("Sheet2").Columns("A").Replace What:="X", Replacement:="*", _
SearchOrder:=xlByColumns, MatchCase:=True

Application.CutCopyMode = True
Application.ScreenUpdating = True

End Sub

 

[atomicluis]

Great! Thanks a lot Joes Was.