|
row highlighter
this is kind of ****e 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 |
row highlighter
And the question is? "numcrun" wrote in message om... this is kind of ****e 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 |
| All times are GMT +1. The time now is 04:06 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com