SelectionChange not working

Question

Here is my code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim LastRow As Long

If Not Intersect(Target, Range("C7,D7,E7,F7,G7,C8,D8,E8,F8,G8,C9,D9,E9,F9,G9,C10,D10,E10,F10,G10,C11,D11,E11,F11,G11")) Is Nothing Then

Application.EnableEvents = False

    With Selection.Borders(xlDiagonalDown)

        .LineStyle = xlContinuous

        .ColorIndex = xlAutomatic

        .TintAndShade = 0

        .Weight = xlThick

    End With

    With Selection.Borders(xlDiagonalUp)

        .LineStyle = xlContinuous

        .ColorIndex = xlAutomatic

        .TintAndShade = 0

        .Weight = xlThick

    End With

    Selection.Borders(xlEdgeLeft).LineStyle = xlNone

    Selection.Borders(xlEdgeTop).LineStyle = xlNone

    Selection.Borders(xlEdgeBottom).LineStyle = xlNone

    Selection.Borders(xlEdgeRight).LineStyle = xlNone

    Selection.Borders(xlInsideVertical).LineStyle = xlNone

    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    With Selection.Font

        .ThemeColor = xlThemeColorDark1

        .TintAndShade = -0.249977111117893

    End With

    End If

End Sub

It only works after the first cell I click in.  It doesn't work for the remainder of the range.  It's supposed to make an "X" in the cell.  I want it to work for the whole range.

Thanks

Answer 1

You don't need  Dim LastRow as Long

You can define your range with a few less references also.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Const WS_RANGE As String = "C7:G11"

If Not Intersect(Target, Range(WS_RANGE)) Is Nothing Then

On Error GoTo endit  'trap for error so's events get re-enabled

Application.EnableEvents = False

    With Selection.Borders(xlDiagonalDown)

        .LineStyle = xlContinuous

        .ColorIndex = xlAutomatic

        .TintAndShade = 0

        .Weight = xlThick

    End With

    With Selection.Borders(xlDiagonalUp)

        .LineStyle = xlContinuous

        .ColorIndex = xlAutomatic

        .TintAndShade = 0

        .Weight = xlThick

    End With

    Selection.Borders(xlEdgeLeft).LineStyle = xlNone

    Selection.Borders(xlEdgeTop).LineStyle = xlNone

    Selection.Borders(xlEdgeBottom).LineStyle = xlNone

    Selection.Borders(xlEdgeRight).LineStyle = xlNone

    Selection.Borders(xlInsideVertical).LineStyle = xlNone

    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    With Selection.Font

        .ThemeColor = xlThemeColorDark1

        .TintAndShade = -0.249977111117893

    End With

    End If

endit:

Application.EnableEvents = True

End Sub

Answer 2

Hi,

try this....

in a regular Module paste the code.

Select a cell or cells, in range C7:G11

and run the code

Sub Diagonal_UpDown()

For Each r In Range("C7:G11")

If Intersect(Selection, r) Is Nothing Then GoTo myEx

With r

.Borders(xlDiagonalDown).LineStyle = xlContinuous

.Borders(xlDiagonalUp).LineStyle = xlContinuous

.Borders(xlEdgeLeft).LineStyle = xlNone

.Borders(xlEdgeTop).LineStyle = xlNone

.Borders(xlEdgeBottom).LineStyle = xlNone

.Borders(xlEdgeRight).LineStyle = xlNone

End With

With r.Font

.ThemeColor = xlThemeColorDark1

.TintAndShade = -0.249977111117893

End With

myEx:

Next r

End Sub

Answer 3

Thanks, but I'm not sure how to write it.

Answer 4

You need to re-enable events at the bottom.