How to get Word VBA Convert Selection Range from one Shade to another Confined to End of Selected Range?

Question

The Selection Range cannot be retained in the macro, or confined to end of Selection bounds. The following combination of 2 subs with the Function below do a great job but cannot:

1. Retain two separate Selection Ranges, the original Selection “rg” becomes “FrstChar”, cannot revert back to original rg Selection later in the routine. I was hoping they would stay autonomous.
2. Selection Range does not end: Conversion runs from Start Selection to End of Document rather than Start Selection to End Selection. This may require complete revamp of Range technique, way over my learner VBA capability. Timothy Rylatt answered gave a brilliant answer to a similar inquiry Converting Highlighting to Shade Equivalents 27 Jan 2024 (following URL), not sure if that same technique could be used to confine the Selection range? Word VBA Convert Highlight to Shade (1) How to limit Code to Selected Range? (2) Is there Code more efficient than Char by Character+ loop each color?

`Sub ShadRepLg_iBx_Alti()
‘ Great! Works on Selection BUT inc EVERYthing after Selection included
    Dim FindLongShadeCol As Long
    Dim ReplacLongShadeCol As Long
    Dim rg As Range
    Set rg = Selection.Range
    Dim FrstChar As String
    Dim ShadeLong As Variant 'CP attempt to get default most recent Clipbd
    Dim ClipShade As String
    ClipShade = Clipboard
'    ShadeLong = Selection.Font.Shading.BackgroundPatternColor
'   CP 16Mar24 above ShadeLong replaced below=isolates 1st char, must isolate 1st word first.
       With Selection.Range
        .Collapse wdCollapseStart
        '.MoveStartUntil " "
        .MoveEndUntil " "
        .MoveEnd wdCharacter
        .Select
        End With
        FrstChar = Left(Selection.Range, 1)
        Debug.Print "FrstChar= "; FrstChar
            ShadeLong = Selection.Font.Shading.BackgroundPatternColor
        Debug.Print "ShadeLong= "; ShadeLong
'   was If Selection.Font.Shading.BackgroundPatternColor = 9999999 Then ShadeLong = ClipShade Else ShadeLong = Selection.Font.Shading.BackgroundPatternColor
'    Default = ClipShade
'   CP: Excellent BUT not consistent/precise, Changes OUTSIDE Selection, some Shading Refuse to change.
'   Alternative: Set rg = ActiveDocument.Range
    FindLongShadeCol = InputBox(ShadeLong & "= 1st Char in Selecn Shade Col ", "RGB Shade LONG to replace", ShadeLong)
    ReplacLongShadeCol = InputBox(ClipShade & " =Clipbd OR Last RGB used", "RGB Shade Font Col to replace", ClipShade)
    With rg.Find
        .Format = True
        .Text = ""
        .Font.Shading.BackgroundPatternColor = ShadeLong     'FindLongShadeCol
'        .Font.Shading.BackgroundPatternColor = RGB(128, 0, 0)
'        .Font.Shading.BackgroundPatternColor = RGB(201, 255, 234)
        .Replacement.Text = ""
        While .Execute
            rg.Font.Shading.BackgroundPatternColor = ClipShade   'ReplacLongShadeCol
'            rg.Font.Shading.BackgroundPatternColor = RGB(0, 0, 0)
'            rg.Font.Shading.BackgroundPatternColor = RGB(255, 214, 153)
            rg.Collapse wdCollapseEnd
        Wend
    End With
End Sub

Function Clipboard(Optional StoreText As String) As String
'PURPOSE: Read/Write to Clipboard
'Source: ExcelHero.com (Daniel Ferry)
Dim x As Variant
'Store as variant for 64-bit VBA support
  x = StoreText
'Create HTMLFile Object
  With CreateObject("htmlfile")
    With .parentWindow.clipboardData
      Select Case True
        Case Len(StoreText)
          'Write to the clipboard
            .setData "text", x
        Case Else
          'Read from the clipboard (no variable passed through)
            Clipboard = .GetData("text")
      End Select
    End With
  End With
End Function



Function Clipboard(Optional StoreText As String) As String
'PURPOSE: Read/Write to Clipboard
'Source: ExcelHero.com (Daniel Ferry)
Dim x As Variant
'Store as variant for 64-bit VBA support
  x = StoreText
'Create HTMLFile Object
  With CreateObject("htmlfile")
    With .parentWindow.clipboardData
      Select Case True
        Case Len(StoreText)
          'Write to the clipboard
            .setData "text", x
        Case Else
          'Read from the clipboard (no variable passed through)
            Clipboard = .GetData("text")
      End Select
    End With
  End With
End Function`