Error 4605 "this method or property is not available because there is a memory or disk error" upon running Macro

Question

This is the MS-Word Macro. It produces this error:

Error 4605 "this method or property is not available because there is a memory or disk problem

' Word script to remove all unused styles in the document
Sub DeleteUnusedStyles()
Dim Doc As Document, bDel As Boolean
Dim Rng As Range, StlNm As String, i As Long
Application.ScreenUpdating = False
Set Doc = ActiveDocument
With Doc
  For i = .Styles.Count To 1 Step -1
    With .Styles(i)
      If .BuiltIn = False Then
        bDel = True: StlNm = .NameLocal
        For Each Rng In Doc.StoryRanges
          With Rng
            With .Find
              .ClearFormatting
              .Format = True
              .Style = StlNm
              .Execute
            End With
            If .Find.Found = True Then
              bDel = False
              Exit For
            End If
          End With
        Next
        If bDel = True Then .Delete
      End If
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

It should remove all unused styles from a word document. I have found on the internet and tested 3 other macros that ought to do the same thing, but with the same error coming up in the end. The Word document pauses for about 5 minutes (it's 100 pages document heavily formatted) and then it spits out this error. I can see memory consumption for the word process increasing almost 5 times before the error appears. I still have more than enough RAM though. I run authentic Word 2013 on Windows 8.1 x86_64. Why is this happening and how do i fix the error?

Answer 1

In this case it is obviously the Undo stack clogging up.

Simple fix: Amend the code like this:

        '...
        '...
        Next
        If bDel = True Then .Delete
        Doc.UndoClear
    End If
End With

Answer 2

Enable Developer menu from File/options/customized ribon.

then pres ALT-F11 and pasted this code in there. press F5.

Sub Removedenter code hereNonDefaultStyles()
Dim CurrentStyleInLoop As Style
   For Each CurrentStyleInLoop In ActiveDocument.Styles
If Not CurrentStyleInLoop.BuiltIn Then
     CurrentStyleInLoop.Delete
End If
Next CurrentStyleInLoop
End Sub