• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Strikethrough by checking checkboxes

Manish Sharma

Manish Sharma

Member
Hi Friends,

I am trying to write a code through which as soon as we check the checkbox entire row gets Strikthrough from column A to D.

I have attached a sample file, to not confuse anyone.

Thanks a lot.
 

Attachments

  • Strikthrough Example.xlsm
    18.4 KB · Views: 5
NARAYANK991 said:
Hi ,

See the attached file.

Narayan
Click to expand...

Thank you Narayan for your help. It worked but i was trying to run the code as soon as the user clicks on the check boxes. I am wondering if it is possible to do so without manually assigning the codes to each check boxes. As it would be a tedious job mannully assign codes to some 100 check boxes.
 
Manish Sharma said:
I am wondering if it is possible to do so without manually assigning the codes to each check boxes. As it would be a tedious job mannully assign codes to some 100 check boxes.
Click to expand...
Hi ,

Can you explain what this means ?

What code is being manually assigned to each check box ?

Narayan
 
Narayan, how about this one?:
Code: 
Public Sub StrikeThroughData()
Dim chkbox As Shape
Set chkbox = Shapes(Application.Caller)
Range("A:D").Rows(chkbox.TopLeftCell.Row).Font.Strikethrough = chkbox.ControlFormat.Value = Checked
End Sub
 
Miy method is similar to p45cal's. Assign this to each control. I set a sheet Protect with no password to show how to lock the sheet but let code modify it.

TIP: Hold control key down and right click each control and then Assign the one macro.

Code: 
Sub fst()
    Dim s As Shape, r As Range, lr As Long

  ActiveSheet.Protect UserInterfaceOnly:=True, DrawingObjects:=True, _
    Contents:=True, Scenarios:=True

  With ActiveSheet
    Set s = .Shapes(Application.Caller)
    If Left(s.Name, 9) <> "Check Box" Then Exit Sub
    lr = s.TopLeftCell.Row
    Set r = .Range(.Cells(lr, "A"), .Cells(lr, s.TopLeftCell.Column - 1))
    r.Font.Strikethrough = s.ControlFormat.Value = Checked
  End With
End Sub
 
Hi Friends,

I was wondering, if instead of all striking all the cell in the row, can we strike through cells only in column A and D.
 
Code: 
'Set r = .Range(.Cells(lr, "A"), .Cells(lr, s.TopLeftCell.Column - 1))
    Set r = Union(.Cells(lr, "A"), .Cells(lr, "D"))
 
Kenneth Hobson said:
Code: 
'Set r = .Range(.Cells(lr, "A"), .Cells(lr, s.TopLeftCell.Column - 1))
    Set r = Union(.Cells(lr, "A"), .Cells(lr, "D"))
Click to expand...
Wow Kenneth, i was not aware of the "union" syntax. Thanks for letting me know about this.

If you don't mind can i ask one more question related to check boxes.

Is it possible to hide the check boxes if either of the cells in column A or D are blank (i.e. check boxes should be visible only when both cells in A and D are non blanks).
 
Yes. What I would do is use a Worksheet Change Event.

Normally, one might run a batch macro to fix the missing ones and then use the Change event to maintain the status as they change in value. Of course if more than one of the target cells, say columns A or C change in value, it would act on the change for each. If coded this way, Intersect() would act on each of the targeted cell rows. The usual method to code Change events is to skip it if more than one cell in the target range was changed. Doing it for all, avoids the need for a batch fix method as a cut/paste would trigger what you want to fix things up. While a little more work, adding a loop to act on multiple target changed cells all at once (cut/paste, delete) is usually best.

I wasn't sure about the "-" part of your other thread. A filter obviously hides the rows. A AND filter for the "-" might suit your needs. I would have to read the thread more closely. I will check back on that thread tonight.
 
Last edited:
Kenneth Hobson said:
Yes. What I would do is use a Worksheet Change Event.

Normally, one might run a batch macro to fix the missing ones and then use the Change event to maintain the status as they change in value. Of course if more than one of the target cells, say columns A or C change in value, it would act on the change for each. If coded this way, Intersect() would act on each of the targeted cell rows. The usual method to code Change events is to skip it if more than one cell in the target range was changed. Doing it for all, avoids the need for a batch fix method as a cut/paste would trigger what you want to fix things up. While a little more work, adding a loop to act on multiple target changed cells all at once (cut/paste, delete) is usually best.

I wasn't sure about the "-" part of your other thread. A filter obviously hides the rows. A AND filter for the "-" might suit your needs. I would have to read the thread more closely. I will check back on that thread tonight.
Click to expand...

Thanks Kenneth, for the reply. Would you mind if i say that i understood very little from the above post. Can you please write the code for me if it will not take much of your time.
 
I don't see it for your post #7 nor post #2 p45cal. Here is how I would do post #7 method in mine for discontinuous columns. There may be shorter ways.
Code: 
'Set r = Range("A:D").Rows(s.TopLeftCell.Row)
    Set r = Intersect(Union(.Columns("A"), .Columns("D")), .Rows(s.TopLeftCell.Row))
 
Yes you're right Kenneth, it does A to D, not just A and D. I can't test this right now but try:
Code: 
  Public Sub StrikeThroughData()
  Dim chkbox As Shape
  Set chkbox = Shapes(Application.Caller)
  Rows(chkbox.TopLeftCell.Row).range("A1,D1").Font.Strikethrough = chkbox.ControlFormat.Value = Checked
  End Sub
 
Last edited:
Yes, that works fine in the Sheet. ;)

If in a module, we just need to add ActiveSheet.
Code: 
'Set chkbox = Shapes(Application.Caller)
  Set chkbox = activesheet.Shapes(Application.Caller)

MOD EDIT: TYPO IN THE CODE CORRECTED.
 
Last edited by a moderator:
You must log in or register to reply here.
Back
Top