Find and Replace Loop does not find all and loop properly

Hi,

The below code is meant to find special characters and replace them. I am using it in a worksheet that has ~300 rows and columns A-X.

It seems to pick up some special characters and replace them but not all of them? If I run the macro again it will find more but again not all, and basically I have to keep running and manually check until it finds them all. Yet it does not report any errors? Please help I can't figure this one out.

Sub SpecialCharactersCheck()

    Dim fndList As Variant
    Dim rplcList As Variant
    Dim rFound As Range
    Dim response As VbMsgBoxResult
    Dim x As Long
    Dim vFile1 As Variant
    Dim newWB As Workbook
    Dim newWBS As Worksheet
    
    'Message box asking user to select the appropriate workbook
    MsgBox ("Please select the workbook containing the Worksheet: ValidationRules-Common")
            
    'Open the target workbook
    vFile1 = Application.GetOpenFilename("Excel-files,*.xls*", _
    1, "Select document to check for special characters", , False)

    'If the user didn't select a file, exit sub
    If TypeName(vFile1) = "Boolean" Then Exit Sub
    
    'Set the workbook and worksheet
    Set newWB = Workbooks.Open(vFile1)
    Set newWBS = newWB.Worksheets("ValidationRules-Common")
    
    'Search all cells in the ValidationRules-Common sheet
    For Each cell In ActiveSheet.UsedRange.Cells
    
        fndList = Array("‘", "–", "’", "“", "”")
        rplcList = Array("'", "-", "'", """", """")
        
        Do
            For x = LBound(fndList) To UBound(fndList)
                'Reset the found variable and search
                Set rFound = Nothing
                Set rFound = newWBS.Cells.Find(What:=fndList(x), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
                SearchFormat:=False)
                
                'Check if a special character was found.
                If Not rFound Is Nothing Then
                    response = MsgBox("The special character: " & fndList(x) & " was found in cell " & rFound.Address(0, 0) & ". Do you want to replace it?", vbInformation + vbYesNoCancel)
                    If response = vbYes Then
                        rFound.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
                        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
                        SearchFormat:=False, ReplaceFormat:=False
                        rFound.Cells.Interior.ColorIndex = 6
                        'rFound.Cells.Characters.Font.Color = vbRed
                    End If
                    If response = vbNo Then
                        MsgBox ("Skipping Character change")
                    End If
                    If response = vbCancel Then
                        MsgBox ("Macro stopped, there may still be special characters in the worksheet")
                        Exit Sub
                    End If
                End If
                
            Next x
        'Loop until no more special characters are found
        Loop Until rFound Is Nothing
        MsgBox ("Macro finished")
        Exit Sub
    Next
End Sub

Thanks,
Mattyfaz