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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.