Border style to top of 2 cells. Not dependent on cell contents, just a button for user to push to a

[StargateFanFromWork]

I need to apply a border style to the top of 2 cells in columns A and B
determined by the cell that is active. i.e., if I need to apply the border
to the tops of A18 and B18, for example, would like to just go to either
cell and click on the button to do this without selecting.

To do this manually and with prior selecting, the recorded macro works and
this is the result:
****************************************************************************
********************************
Sub APPLY_ColouredTopBorder()
'
ActiveSheet.Unprotect 'place at the beginning of the code
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDash
.Weight = xlMedium
.ColorIndex = 3
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
ActiveSheet.Protect ' place at end of code
End Sub
****************************************************************************
********************************
To revert back to the regular formatting of that border for selected cells,
the recorded macro comes out like this:
****************************************************************************
********************************
Sub REMOVE_ColouredTopBorder()
'
ActiveSheet.Unprotect 'place at the beginning of the code
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
ActiveSheet.Protect ' place at end of code
End Sub
****************************************************************************
********************************

I'm hoping that there is a perhaps better way of coding this that will do
the same thing, but that also applies/removes the border style without
having to select the target cells? TIA. D

 

[Guest]

Give this a try...

Sub APPLY_ColouredTopBorder()
dim rngToFormat as range

set rngToFormat = intersect(selection.entirerow, columns("A:B"))
ActiveSheet.Unprotect 'place at the beginning of the code
rngToFormat .Borders(xlDiagonalDown).LineStyle = xlNone
rngToFormat .Borders(xlDiagonalUp).LineStyle = xlNone
With rngToFormat .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With rngToFormat .Borders(xlEdgeTop)
.LineStyle = xlDash
.Weight = xlMedium
.ColorIndex = 3
End With
With rngToFormat .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With rngToFormat .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With rngToFormat .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
ActiveSheet.Protect ' place at end of code
End Sub
****************************************************************************
********************************
To revert back to the regular formatting of that border for selected cells,
the recorded macro comes out like this:
****************************************************************************
********************************
Sub REMOVE_ColouredTopBorder()
dim rngToFormat as range

set rngToFormat = intersect(selection.entirerow, columns("A:B"))
ActiveSheet.Unprotect 'place at the beginning of the code
rngToFormat .Borders(xlDiagonalDown).LineStyle = xlNone
rngToFormat .Borders(xlDiagonalUp).LineStyle = xlNone
With rngToFormat .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With rngToFormat .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With rngToFormat .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With rngToFormat .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With rngToFormat .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
ActiveSheet.Protect ' place at end of code
End Sub

 

[StargateFanFromWork]

Lordy, but that is _perfect_ and works like a charm. There were a couple of
errors initially that the vbe kept bringing up but I figured out that there
was unneeded space before some of the periods [i.e., changed "With
rngToFormat .Borders(xlEdgeLeft)" to "With rngToFormat.Borders(xlEdgeLeft)"]
<g>.

With a simple click on two new buttons on the commandbar (floating toolbar),
because of the new code below, user can put a "separator" between entries,
or remove, as desired. And all this without fussing with selecting the
actual cells. Very kewl.

Thank you! D