MACRO to add corner to corner "X" on doubleclick

[NullSpot]

Greetings,

Couldn't find a post with this, if you know of one, please direct me to it!

I've tried to use a MACRO to add diag bold lines to cells based on double click. I've gotten it to work on some of them.

I would like a dbl click to add/remove lines based on current value. So, if the "X" is already there, then Dbl Click would remove it, if not, it would add it. I assume an IF/Then code?

I have also struggled with the proper format for range. I've used Select Case with some success,. but wonder if that's the best way.

Finally, I would love constructive feedback on a better way. Maybe I have already found it, but it sure seems cumbersome.

Cell K11 is an example.

Your help is much appreciated.

[Mumps1]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab for your sheet and click 'View Code'. Paste the macro into the empty code window that opens up. I assumed that you wanted to apply the macro to columns K and L only. If that is not the case, then the range in the code will have to be modified to suit your needs. Close the code window to return to your sheet. Double click any cell in columns K or L. You may have to exit the cell after you double click it to see the effect.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("K:L")) Is Nothing Then Exit Sub
    If Target.Borders(xlDiagonalDown).LineStyle = xlContinuous = False Then
        With Target
            .Borders(xlDiagonalDown).LineStyle = xlContinuous
            .Borders(xlDiagonalDown).Weight = xlThick
            .Borders(xlDiagonalUp).LineStyle = xlContinuous
            .Borders(xlDiagonalUp).Weight = xlThick
        End With
    Else
        With Target
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
        End With
    End If
End Sub

[NullSpot]

Thank you. It works great! I spent days fooling with it.

You are correct that it would be applied in other places.

It is applied to ranges and single cells. So K5:K7, K9, D3:D5, etc. How do I address those? I figured something like:

Range("K5:K7, D3:D5"), K9

I think the second comma is wrong though...how close did I get?

[Mumps1]

Pretty close.

If Intersect(Target, Range("K5:K7, K9, D3:D5")) Is Nothing Then Exit Sub

[NullSpot]

I think I found it! Missing a C on the first location....uh, nevermind...still not working

[NullSpot]

Thanks so much!

So, here is my code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("C27:28, C32:C33, C36, D16:D17, D25, D38, D66, E16:E17, E25, E27:E28, E32:E33, F36, F38, F66, H27:H28, H32:H33, H38, H66, I16:I17, I25, I36, J16:J17, J25, J27:J28, J32:J33, J38, J66, K6:K7, K9:K12, K18:K23, K29, K34, K41:K57, K60:K65, L6:L7, L9:L12, L18:L23, L29, L34, L36, L38, L41:L57, L60:L65, M36, N38, P36, P38, Q36, R38")) Is Nothing Then Exit Sub
    If Target.Borders(xlDiagonalDown).LineStyle = xlContinuous = False Then
        With Target
            .Borders(xlDiagonalDown).LineStyle = xlContinuous
            .Borders(xlDiagonalDown).Weight = xlThick
            .Borders(xlDiagonalUp).LineStyle = xlContinuous
            .Borders(xlDiagonalUp).Weight = xlThick
        End With
    Else
        With Target
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
        End With
    End If
End Sub

It's very long, and I can't get it to work now. When I added all those different cells, that's when it stopped.

[NullSpot]

I also tried it this way:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("C27, C28, C32, C33, C36, D16, D17, D25, D38, D66, E16, E17, E25, E27, E28, E32, E33, F36, F38, F66, H27, H28, H32, H33, H38, H66, I16, I17, I25, I36, J16, J17, J25, J27, J28, J32, J33, J38, J66, K6, K7, K9:K12, K18:K23, K29, K34, K41:K57, K60:K65, L6, L7, L9:L12, L18:L23, L29, L34, L36, L38, L41:L57, L60:L65, M36, N38, P36, P38, Q36, R38")) Is Nothing Then Exit Sub
    If Target.Borders(xlDiagonalDown).LineStyle = xlContinuous = False Then
        With Target
            .Borders(xlDiagonalDown).LineStyle = xlContinuous
            .Borders(xlDiagonalDown).Weight = xlThick
            .Borders(xlDiagonalUp).LineStyle = xlContinuous
            .Borders(xlDiagonalUp).Weight = xlThick
        End With
    Else
        With Target
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
        End With
    End If
End Sub

[Mumps1]

When you're dealing with this type of a range, it sometimes is better for you to use a named range. Do the following: Click on the first cell in the range to select it. Then, while holding down the CTRL key, click on all the other cells in the range until they are all selected. Be very careful to not make a mistake in selecting any cell or you may have to start from the beginning. Once they are all selected, right click on any of them and click 'Define name..". Enter a name such as 'Borders' for this range and click 'OK'. The range has now been stored using that name. Now you can use this line of code:

If Intersect(Target, Range("Borders")) Is Nothing Then Exit Sub

Give it a try.

[alansidman]

@NullSpot

Code Tags Added
Your post does not comply with Rule 3 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.)

[NullSpot]

Like a CHAMP!!! Thanks so much.

[Mumps1]

You are very welcome.

[NullSpot]

I know this is solved, but I wonder if you can tell me how to add a button that will clear the "X" from every cell? Also, on this document text is written in to many different cells. Could one button remove the text and "X" so new data can be entered each day?

[Mumps1]

Do you want to clear all the cells of text and X's or just certain ranges? For example, if you have headers in row 1, do you want to keep them. Please be specific as to which cells you want to clear. If you could attach a copy of your file (de-sensitize if necessary) it would be easier to test any possible solution.

[NullSpot]

I've attached the document. Any cell that currently has an X or is filled with red, are the affected cells. So I'm hoping a "CLEAR" button will remove the "X" and any text in the red cells. Thanks!

[Mumps1]

Could you attach a version of your file that contains the macro you are currently using and the named range as well? Are the cells that currently have an X in them in the file you attached the only cells that can ever have an X or are there others? If there are others, please place an X in them as well so I have an idea of the complete range that can contain an X. I assume the cells colored in red are the complete range and won't change. I'll be away fom my computer most of the day today so I'll respond as soon as I can.

[NullSpot]

I've attached updated worksheet. The "X" cells are the only cells that can have an X. Your assumption on the "RED" cells is correct. Below is the MACRO you wrote for this function. Thanks for your help!

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("Checkboxes")) Is Nothing Then Exit Sub
    If Target.Borders(xlDiagonalDown).LineStyle = xlContinuous = False Then
        With Target
            .Borders(xlDiagonalDown).LineStyle = xlContinuous
            .Borders(xlDiagonalDown).Weight = xlThick
            .Borders(xlDiagonalUp).LineStyle = xlContinuous
            .Borders(xlDiagonalUp).Weight = xlThick
        End With
    Else
        With Target
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
        End With
    End If
End Sub

[Mumps1]

Try the attached file. I've added two named ranges, the first is named "Checkboxes" and the second is named "CellsToClear". Just click the "Clear Cells" button at the top.

[NullSpot]

Try the attached file. I've added two named ranges, the first is named "Checkboxes" and the second is named "CellsToClear". Just click the "Clear Cells" button at the top.

I’ll give it a try. In the future, can I add additional cells to the “Cells to Clear” range; even on different sheets. Effectively creating one button that clears everything that I input, on every sheet daily?

[NullSpot]

Worked like a champ! Thanks!

[Mumps1]

You can add more cells from the same sheet to the named range at any time. Unfortunately, I don't think that you can add cells form a different sheet to that named range. You would have to create a named range for each sheet and refer to each one in the macro.