Reformat Borders of Cells in Selection - an example

[DataFreakFromUtah]

No question here, just a procedure for the archive.

Sub BorderLinesOfCellReformat()

'Reformats all formatted borders in selection to target color,
linestyle and weight specified below in VBE
'This procedure DOES NOT ADD NEW BORDERS, it just modifies/reformats
EXISITING borders in selection
'This procedure is very useful for a mass reformatting of an existing
intricate border formatting

Dim ColorChangeTo As Integer, LStyle As Long, Wght As Variant, cell
As Range
'*******************************************************************************************************************************************************

'Make overall format assigns for procedure here:
ColorChangeTo = xlAutomatic 'xlAutomatic for default black, 56
color options, eg. 3 = red, see VBA Help
LStyle = xlContinuous 'LineStyle constant opions are:
xlContinuous, xlDash, xlDashDot, xlDashDotDot, xlDot, xlDouble,
xlSlantDashDot, xlLineStyleNone, xlNone
Wght = xlThin 'Weight constant options are:
xlHairline, xlNone, xlThin, xlMedium, or xlThick
'*******************************************************************************************************************************************************
On Error Resume Next
For Each cell In Selection

'Evaluate left edge of cell for border presence

If Not cell.Borders(xlEdgeLeft).LineStyle = xlNone Then
With cell.Borders(xlEdgeLeft)
.LineStyle = LStyle
.Weight = Wght
.ColorIndex = ColorChangeTo

End With
End If

'Evaluate top edge of cell for border presence

If Not cell.Borders(xlEdgeTop).LineStyle = xlNone Then

With cell.Borders(xlEdgeTop)
.LineStyle = LStyle
.Weight = Wght
.ColorIndex = ColorChangeTo
End With
End If

'Evaluate bottom edge of cell for border presence

If Not cell.Borders(xlEdgeBottom).LineStyle = xlNone Then

With cell.Borders(xlEdgeBottom)
.LineStyle = LStyle
.Weight = Wght
.ColorIndex = ColorChangeTo
End With
End If

'Evaluate right edge of cell for border presence

If Not cell.Borders(xlEdgeRight).LineStyle = xlNone Then

With cell.Borders(xlEdgeRight)
.LineStyle = LStyle
.Weight = Wght
.ColorIndex = ColorChangeTo

End With
End If

Next cell

End Sub



Search criteria:
autoreformat borders change borders programmatically auto-reformat
borders
reformat borders reformat existing borders change border format change
borders
change cell borders reformat cell borders in selection
xlEdgeLeft format change xlEdgeRight format change xlEdgeTop format
change
xlEdgeBottom format change reformat border linestyle change border
linestyle
format cells border reformat cells border reformat cell borders