Resolve Automatic Formatting Error Handling

[RMajor]

Request: how can the macro below be corrected to consistently and efficiently format all available data in any worksheet based on the following criteria?

1. 'reformat number formulas with black font'
2. 'reformat text constants with black font'
3. 'reformat number constants with blue font'
4. 'reformat internal references with green font'
5. 'reformat external references with white font & purple fill'
6. 'reformat hyperlinks with blue font & underline'
7. 'reformat errors with white font & red fill'
8. 'maximize font contrast in cells with fill color'

Problem: the macro will sometimes format incorrectly, fail to format, or freeze my computer. Problem typically arises when only some of the referenced criteria is present (i.e., a worksheet contains only hard-coded data).

Attempted (failed) solutions: (1) using various combinations and placements of error handlers; (2) reordering the subs.

Thank you.


****VBA start****

On Error Resume Next

'reformat number formulas with black font'
Selection.SpecialCells(xlCellTypeFormulas, 1).Select
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With

'reformat text constants with black font'
Selection.SpecialCells(xlCellTypeConstants, 2).Select
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With

'reformat number constants with blue font'
Selection.SpecialCells(xlCellTypeConstants, 1).Select
With Selection.Font
.Color = -65536
.TintAndShade = 0
End With
Exit Sub

'reformat internal references with green font'
Cells.Select
Application.FindFormat.Clear
Application.ReplaceFormat.Clear
With Application.ReplaceFormat.Font
.Color = -16738048
End With
Cells.Replace What:="*!*", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=True
Application.FindFormat.Clear
Application.ReplaceFormat.Clear

'reformat external references with white font & purple fill'
Cells.Select
Application.FindFormat.Clear
Application.ReplaceFormat.Clear
With Application.ReplaceFormat.Font
.Subscript = False
.ThemeColor = 1
.TintAndShade = 0
End With
With Application.ReplaceFormat.Interior
.PatternColorIndex = xlAutomatic
.Color = 10498160
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Cells.Replace What:=".xl", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=True, _
FormulaVersion:=xlReplaceFormula2
Application.ReplaceFormat.Clear

'reformat hyperlinks with blue font & underline'
Dim LinkRange As Range
Dim Link As Hyperlink
Dim IsFirstCellInRange As Boolean
IsFirstCellInRange = True
If ActiveSheet.Hyperlinks.Count > 0 Then
For Each Link In ActiveSheet.Hyperlinks
If IsFirstCellInRange = True Then
Set LinkRange = Link.Range
IsFirstCellInRange = False
Else
Set LinkRange = Application.Union(LinkRange, Link.Range)
End If
Next Link
LinkRange.Select
Selection.Font.Underline = xlUnderlineStyleSingle
Selection.Font.Color = -26317
End If

'reformat errors with white font & red fill'
Selection.SpecialCells(xlCellTypeFormulas, 16).Select
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With

'maximize font contrast in cells with fill color'
Union(Selection.SpecialCells(xlCellTypeConstants, 23), Selection.SpecialCells(xlCellTypeFormulas, 23)).Select
For Each cell In Selection
cell.Font.Color = BorW(cell.Interior.Color)
Next cell

End Sub

Function BorW(RGB As Long) As Long
Dim R As Integer, G As Integer, B As Integer
R = (RGB And &HFF)
G = (RGB And &HFF00&) / 256
B = (RGB And &HFF0000) / 65536
BorW = vbWhite
If R * 0.3 + G * 0.59 + B * 0.11 > 128 Then BorW = vbBlack
End Function