N
numcrun
this is kind of shite but i prefer it to microsofts kb method.
Dim xbar As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
xbar = ActiveCell.Row
ybar = ActiveCell.Column
If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
For f = 1 To 20
With Cells(Application.WorksheetFunction.Max(1, xbar - f), ybar)
If .Borders(xlEdgeLeft).Weight = xlThick Then
With Range("A" & Application.WorksheetFunction.Max(1, xbar - f) & ":BE" & _
Application.WorksheetFunction.Max(1, xbar - f))
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
End If
End With
Next
For f = 1 To 20
With Cells(xbar + f, ybar)
If .Borders(xlEdgeLeft).Weight = xlThick Then
With Range("A" & xbar + f & ":BE" & xbar + f)
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
End If
End With
Next
curr_row = ActiveCell.Row
With Range("A" & curr_row & ":BE" & curr_row).Borders(xlEdgeLeft)
.Weight = xlThick
End With
With Range("A" & curr_row & ":BE" & curr_row).Borders(xlEdgeTop)
.Weight = xlThick
End With
With Range("A" & curr_row & ":BE" & curr_row).Borders(xlEdgeBottom)
.Weight = xlThick
End With
With Range("A" & curr_row & ":BE" & curr_row).Borders(xlEdgeRight)
.Weight = xlThick
End With
With Range("A" & curr_row & ":BE" & curr_row).Borders(xlInsideVertical)
.Weight = xlThick
End With
End If
ActiveCell.Borders(xlEdgeRight).ColorIndex = 4
ActiveCell.Borders(xlEdgeTop).ColorIndex = 4
ActiveCell.Borders(xlEdgeLeft).ColorIndex = 4
ActiveCell.Borders(xlEdgeBottom).ColorIndex = 4
End Sub
Dim xbar As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
xbar = ActiveCell.Row
ybar = ActiveCell.Column
If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
For f = 1 To 20
With Cells(Application.WorksheetFunction.Max(1, xbar - f), ybar)
If .Borders(xlEdgeLeft).Weight = xlThick Then
With Range("A" & Application.WorksheetFunction.Max(1, xbar - f) & ":BE" & _
Application.WorksheetFunction.Max(1, xbar - f))
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
End If
End With
Next
For f = 1 To 20
With Cells(xbar + f, ybar)
If .Borders(xlEdgeLeft).Weight = xlThick Then
With Range("A" & xbar + f & ":BE" & xbar + f)
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
End If
End With
Next
curr_row = ActiveCell.Row
With Range("A" & curr_row & ":BE" & curr_row).Borders(xlEdgeLeft)
.Weight = xlThick
End With
With Range("A" & curr_row & ":BE" & curr_row).Borders(xlEdgeTop)
.Weight = xlThick
End With
With Range("A" & curr_row & ":BE" & curr_row).Borders(xlEdgeBottom)
.Weight = xlThick
End With
With Range("A" & curr_row & ":BE" & curr_row).Borders(xlEdgeRight)
.Weight = xlThick
End With
With Range("A" & curr_row & ":BE" & curr_row).Borders(xlInsideVertical)
.Weight = xlThick
End With
End If
ActiveCell.Borders(xlEdgeRight).ColorIndex = 4
ActiveCell.Borders(xlEdgeTop).ColorIndex = 4
ActiveCell.Borders(xlEdgeLeft).ColorIndex = 4
ActiveCell.Borders(xlEdgeBottom).ColorIndex = 4
End Sub