Replace characters but keep format

[Un-Do Re-Do]

The Replace function does not seem to keep formatting when applied to cells with more than one format (different fonts, sizes, superscript/subscript, etc).
Is there a way to keep the formats intact?
The example below replaces the characters "and" with "but", but all other formatting is lost.

Sub Replace_and_keep_Format()
Dim cell As Range, sentence As String
    For Each cell In Selection
        With cell
                sentence = Replace$(.Value, "and", "but")
                .Value = Left$(sentence, Len(sentence) - 0)
        End With
    Next cell
End Sub

[jindon]

Try

Sub test()
    Dim r As Range, x As Long
    For Each r In Selection
        x = InStr(r.Value, "and")
        Do While x > 0
            r.Characters(x, Len("and")).Text = "but"
            x = InStr(x + 1, r.Value, "and")
        Loop
    Next
End Sub

[Un-Do Re-Do]

Thank you very much @jindon.

[Robgui]

Thanks for a great solution.
This works for me however, if I have a cell that has over 245 approx charaters, the words are not replaced.
The text format is perfect.

The code I am using is:

Sub SearchReplace()
Dim r As Range, x As Long
For Each r In Selection
x = InStr(r.Value, "XXX")
Do While x > 0
r.Characters(x, Len("XXX")).Text = learner
x = InStr(x + 1, r.Value, "XXX")
Loop
Next
End Sub

I am replaceing "XXX" with a Public declared variable called "learner" which is a String.

The code does work if the cell has less than 245 characters.

Can anyone help me solve this problem please.

[Un-Do Re-Do]

Try this to store characters and fonts in array.
Example replaces "and" with "but" which are same length. Should be able to change for different length strings when taking into account the font array.

Option Explicit

Sub More_than_256()
    Dim Cell As Range
    
    Dim FontArray As Variant
    Dim TextArray As Variant
    Dim i As Long
    
    Dim the_string As String

    For Each Cell In Selection

        ReDim FontArray(Len(Cell) - 1)
        For i = 1 To Len(Cell)
            FontArray(i - 1) = Cell.Characters(i, 1).Font.Name
        Next

        ReDim TextArray(Len(Cell) - 1)
        For i = 1 To Len(Cell)
            TextArray(i - 1) = Cell.Characters(i, 1).Text
        Next

        For i = 0 To Len(Cell) - 1
            Cell.Characters(i + 1, 1).Text = TextArray(i)
        Next i
        
        the_string = Join(TextArray, "")

    the_string = Replace(the_string, "and", "but")
    Cell.Value = the_string

        For i = 0 To Len(Cell) - 1
            Cell.Characters(i + 1, 1).Font.Name = FontArray(i)
        Next i

    Next Cell
End Sub

[Robgui]

Many thanks Un-Do Re-Do.
I'll give this ago