Maybe try this;

Sub RemoveCharacterStylesExceptSuperscriptInFootnoteReferences()
    Dim storyRange As Range
    Dim charStyle As Style
    Dim charRange As Range
    Dim supRange As Range
    Dim supStyle As Style
    ' Set the style for superscript within footnote references
    On Error Resume Next
    ' Handle potential error if style doesn't exist
    Set supStyle = ActiveDocument.Styles("Footnote Reference")
    On Error GoTo 0
    If supStyle Is Nothing Then
        MsgBox "Footnote Reference style not found. Macro will remove all character styles.", vbExclamation End If
        ' Loop through all stories (main text, headers, footers, etc.)
        For Each storyRange In ActiveDocument.StoryRanges
            ' Process each story
        Do
            ' Loop through all character styles in the story
            For Each charStyle In ActiveDocument.Styles
                If charStyle.Type = wdStyleTypeCharacter Then
                    ' Loop through all ranges with the current character style
                    Set charRange = storyRange.Duplicate
                    With charRange.Find
                        .ClearFormatting
                        .Style = charStyle
                        .Forward = True
                        .Wrap = wdFindStop
                        .Format = True
                        .Execute
                        Do While .Found
                            ' Exclude superscript within footnote references
                            If Not (Not supStyle Is Nothing And charStyle.NameLocal = "Superscript" And charRange.InRange(supStyle.Range)) Then
                                ' Remove the character style
                                charRange.CharacterStyle = ""
                            End If
                            ' Find the next occurrence
                            .Execute
                        Loop
                    End With
                End If
            Next charStyle
            ' Move to the next linked story range
            Set storyRange = storyRange.NextStoryRange
        Loop Until storyRange Is Nothing
    Next storyRange
End Sub