Save and restore (or transfer) a range's format properties

The below procedure saves and restores all format properties of a given range which may be a single cell, merged cells, etc. If the restore range is not the save range the format properties are transferred/copied.
Usage Code (Selection is used here but may be any range):

Dim cll As Collection

    Formats Selection, xlSave, cll
    ' any code here
    Formats Selection, xlRestore, cll

Public Enum xlSaveRestore
    xlSave
    xlRestore
End Enum

Public Sub Formats(ByVal r As Range, _
                   ByVal SaveRestore As xlSaveRestore, _
                   ByRef cll As Collection)
' -------------------------------------------------------
' - xlOffOn = xlSave: Saves all format properties of the
'   range r into the Collection cll.
' - xlOnOff xlRestore = Restores, assigns respectively
'   all saved forma properties to range r.
'
' Note: A collection is used because the Borders
'       properties are saved/restored by means of a
'       Dictionary.
'
' Uses: Borders
' Requires: Reference to "Microsoft Scripting Runtime"
'
' W. Rauschenberger, Berlin July 2019
' -------------------------------------------------------
Dim dct As Dictionary

    Select Case SaveRestore
        Case xlSave
            Set cll = Nothing: Set cll = New Collection
            With r
                With .Font
                    cll.Add .Color
                    cll.Add .ColorIndex
                    cll.Add .Background
                    cll.Add .Bold
                    cll.Add .FontStyle
                    cll.Add .Italic
                    cll.Add .Name
                    cll.Add .OutlineFont
                    cll.Add .Shadow
                    cll.Add .Size
                    cll.Add .Strikethrough
                    cll.Add .Subscript
                    cll.Add .Superscript
                    cll.Add .Underline
                End With
                
                With .Interior
                    cll.Add .Color
                    cll.Add .ColorIndex
                    cll.Add .Pattern
                    cll.Add .PatternColor
                    cll.Add .PatternColorIndex
                End With
                
                cll.Add .HorizontalAlignment
                cll.Add .VerticalAlignment
                cll.Add .NumberFormat
                cll.Add .WrapText
                
            End With
            
            '~~ Save the Borders properties in a Dictionary and add it to the collection
            Borders r, xlSave, dct
            cll.Add dct
            
        Case xlRestore
            '~~ Note: It is absolutely essential to retrieve all properties in the same
            '         The restore sequence has to be exactly the same as the save sequence
            With r
                With .Font
                    .Color = cll.Item(1)
                    .ColorIndex = cll.Item(2)
                    .Background = cll.Item(3)
                    .Bold = cll.Item(4)
                    .FontStyle = cll.Item(5)
                    .Italic = cll.Item(6)
                    .Name = cll.Item(7)
                    .OutlineFont = cll.Item(8)
                    .Shadow = cll.Item(9)
                    .Size = cll.Item(10)
                    .Strikethrough = cll.Item(11)
                    .Subscript = cll.Item(12)
                    .Superscript = cll.Item(13)
                    .Underline = cll.Item(14)
                End With
                
                With .Interior
                    .Color = cll.Item(15)
                    .ColorIndex = cll.Item(16)
                    .Pattern = cll.Item(17)
                    .PatternColor = cll.Item(18)
                    .PatternColorIndex = cll.Item(19)
                End With
                                
                .HorizontalAlignment = cll.Item(20)
                .VerticalAlignment = cll.Item(21)
                .NumberFormat = cll.Item(22)
                .WrapText = cll.Item(23)
                
                '~~ Restore the Borders properties from the Dictionary
                Set dct = cll.Item(24)
                Borders r, xlRestore, dct
                
            End With
    End Select

End Sub

Public Sub Borders(ByVal r As Range, _
                   ByVal SaveRestore As xlSaveRestore, _
                   ByRef dct As Dictionary)
' ------------------------------------------------------
' - xlOffOn = xlSaveOnly: Saves the border properties of
'   Range r into the Dictionary dct.
' - xlOnOff = xlRestore: Restores all border properties
'   for Range r from the Dictionary dct.
'
' Note: A Dictionary allows to save and re-use the
'       XlBordersIndex as key.
'
' Requires: Reference to "Microsoft Scripting Runtime"
'
' W. Rauschenberger, Berlin July 2019
' ------------------------------------------------------
Const sProc = "Borders"
Dim cll     As Collection
Dim bo      As Border
Dim xlBi    As XlBordersIndex
Dim i       As Long

    On Error GoTo on_error
    i = 0
    
    Select Case SaveRestore
        Case xlSave
            Set dct = Nothing
            Set dct = New Dictionary
            For xlBi = xlDiagonalDown To xlInsideHorizontal ' = 5 to 12
                With r.Borders(xlBi)
                    Set cll = New Collection
                    cll.Add .LineStyle
                    cll.Add .Weight
                    cll.Add .Color
                    cll.Add .ColorIndex
                    '~~ !! If Color and ColorIndex are used there is no .ThemeColor property !!
                    If .Color = 0 And .ColorIndex = xlNone Then
                        cll.Add .ThemeColor
                    Else
                        cll.Add Null
                    End If
                    cll.Add .TintAndShade
                End With
                dct.Add xlBi, cll
            Next xlBi
            
        Case xlRestore
            For i = 0 To dct.Count - 1
                xlBi = dct.Keys(i)
                Set cll = dct.Items(i)
                
                With r.Borders(xlBi)
                    .LineStyle = cll.Item(1)
                    If Not .LineStyle = xlNone Then
                        '~~ Any other border formationg only when there is a border
                        .Weight = cll.Item(2)
                        If Not IsNull(cll.Item(5)) Then
                            .ThemeColor = cll.Item(5)
                        Else
                            '~~ Any color only when there is not ThemeColor
                            .Color = cll.Item(3)
                            .ColorIndex = cll.Item(4)
                        End If
                        If Not IsNull(cll.Item(6)) Then
                            .TintAndShade = cll.Item(6)
                        End If
                    End If  ' LineStyle not is xlNone
                End With
                
            Next i
    End Select
    
    Exit Sub

on_error:
    ErrHndlr sMod, sProc
End Sub

Public Sub ErrHndlr(ByVal sMod As String, _
                    ByVal sProc As String, _
           Optional ByVal s1 As String = vbNullString, _
           Optional ByVal s2 As String = vbNullString, _
           Optional ByVal s3 As String = vbNullString, _
           Optional ByVal s4 As String = vbNullString, _
           Optional ByVal s5 As String = vbNullString, _
           Optional ByVal s6 As String = vbNullString, _
           Optional ByVal s7 As String = vbNullString, _
           Optional ByVal s8 As String = vbNullString, _
           Optional ByVal s9 As String = vbNullString)
' ------------------------------------------------------
' Common Error Handler
' ------------------------------------------------------
Dim sTitle  As String
Dim sMsg    As String
Dim sInfo   As String

    sTitle = "VBA-Error " & Err.Number & " in  " & sMod & " . " & sProc
    sMsg = Err.Description & vbLf
    If s1 <> vbNullString Then sInfo = s1
    If s2 <> vbNullString Then sInfo = sInfo & vbLf & s2
    If s3 <> vbNullString Then sInfo = sInfo & vbLf & s3
    If s4 <> vbNullString Then sInfo = sInfo & vbLf & s4
    If s5 <> vbNullString Then sInfo = sInfo & vbLf & s5
    If s6 <> vbNullString Then sInfo = sInfo & vbLf & s6
    If s7 <> vbNullString Then sInfo = sInfo & vbLf & s7
    If s8 <> vbNullString Then sInfo = sInfo & vbLf & s8
    If s9 <> vbNullString Then sInfo = sInfo & vbLf & s9
    sMsg = sMsg & vbLf & sInfo
    MsgBox sMsg, vbExclamation, sTitle
    Application.EnableEvents = True
    
End Sub