PDA

View Full Version : Solved: Excel 2003/2007 - Need to delete top and botom row borders after selection change



frank_m
12-14-2010, 08:23 PM
Please take a look at the attached sample workbook. It is a stripped down version of what I am actually using but it demonstrates what I need.

I want to add top and bottom thick purple borders to the top and bottom of the row after each selection change, while deleting those from the previously selected row.

I have created a range from Column A to Column Q in the selected row and have coded it to add the top and bottom borders as needed, but I need a way to delete all horizontal borders after each selection change, except the bottom border of the last Row. That must be maintained with a thick red border as shown in the sample file.

Thanks for your help

frank_m
12-14-2010, 08:56 PM
I have most of it worked out.

The code I added removes only the top and bottom Borders within my used range without touching the last row bottom border.

Now I only need to add code that prevents adding the purple top and bottom borders if I select the last row or below the last row.

Getting close :whip
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim LastRow As Long

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

With Range("A1:Q" & LastRow - 1)
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With

If ActiveCell.Row > 15 Then

If Selection.Rows.Count = 1 Then

With ActiveSheet.Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 17)).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With

With ActiveSheet.Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 17)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With

End If

End If

Range("A15:Q15").Interior.ColorIndex = 15

Cells(15, ActiveCell.Column).Interior.ColorIndex = 45

End Sub

frank_m
12-14-2010, 09:09 PM
Ok got it - Sorry if I took up anyone's time.

Took care of my final issue by Changing:
If Selection.Rows.Count = 1 Then To:
If Selection.Rows.Count = 1 And Selection.Row < LastRow Then
Below is my final code that works correctly.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim LastRow As Long

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

With Range("A1:Q" & LastRow - 1)
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With

If ActiveCell.Row > 15 Then

If Selection.Rows.Count = 1 And Selection.Row < LastRow Then

With ActiveSheet.Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 17)).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With

With ActiveSheet.Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 17)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 7
End With

End If

End If

Range("A15:Q15").Interior.ColorIndex = 15

Cells(15, ActiveCell.Column).Interior.ColorIndex = 45

End Sub