Consulting

Results 1 to 3 of 3

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

  1. #1
    VBAX Expert
    Joined
    Sep 2010
    Posts
    604
    Location

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

    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

  2. #2
    VBAX Expert
    Joined
    Sep 2010
    Posts
    604
    Location
    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
    [vba]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[/vba]

  3. #3
    VBAX Expert
    Joined
    Sep 2010
    Posts
    604
    Location
    Ok got it - Sorry if I took up anyone's time.

    Took care of my final issue by Changing:
    [vba] If Selection.Rows.Count = 1 Then[/vba] To:
    [vba]If Selection.Rows.Count = 1 And Selection.Row < LastRow Then[/vba]
    Below is my final code that works correctly.
    [vba]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[/vba]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •