Loading
Word.Tips.Net WordTips (Menu Interface)

Removing Unused Styles

When you work with a document for a long time, or when you inherit a document from someone else, it is very possible that it contains styles that are no longer in use. You may want to get rid of these styles, but this can be dangerous to the format of your document if you start deleting them without knowing that they really are not in use.

This is where a macro comes in handy. It can quickly search through a document to see if a particular style is used anywhere. If it isn't, then the style can be easily deleted. The following macro, DeleteUnusedStyles, does just that.

Sub DeleteUnusedStyles()
    Dim oStyle As Style

    For Each oStyle In ActiveDocument.Styles
        'Only check out non-built-in styles
        If oStyle.BuiltIn = False Then
            With ActiveDocument.Content.Find
                .ClearFormatting
                .Style = oStyle.NameLocal
                .Execute FindText:="", Format:=True
                If .Found = False Then oStyle.Delete
            End With
        End If
    Next oStyle
End Sub

Note that the macro ignores a style if it is a built-in style. This is because deleting a built-in style doesn't really delete it, but only resets that style to its original, default condition. In fact, Word doesn't allow built-in styles to be deleted from a document. Even if the built-in style is no longer used, but was once used in the document, it will still show up in the styles drop-down list. If this bothers you, there are additional steps you can take to "delete" the listing of these built-in styles. These steps can be rather involved, and are best described in Knowledge Base article 193536:

http://support.microsoft.com/kb/193536

WordTips is your source for cost-effective Microsoft Word training. (Microsoft Word is the most popular word processing software in the world.) This tip (1337) applies to Microsoft Word 97, 2000, 2002, and 2003.

Related Tips:

Create Custom Apps with VBA! Discover how to extend the capabilities of Office 2013 (Word, Excel, PowerPoint, Outlook, and Access) with VBA programming, using it for writing macros, automating Office applications, and creating custom applications. Check out Mastering VBA for Office 2013 today!

 

Leave your own comment:

*Name:
Email:
  Notify me about new comments ONLY FOR THIS TIP
Notify me about new comments ANYWHERE ON THIS SITE
Hide my email address
*Text:
*What is 5+3 (To prevent automated submissions and spam.)
 
 
           Commenting Terms

Comments for this tip:

Daniel    15 Jul 2016, 03:11
To get Jason's script to work, I had to make the following changes

Dim dicAllStyleNames As Scripting.Dictionary
Dim dicUsedStyleNames As Scripting.Dictionary

becomes

Dim dicAllStyleNames As Object
Dim dicUsedStyleNames As Object
Janus    28 Jun 2016, 06:04
Note that Jason’s version below will not work on a Mac, for several reasons:

1.

The Scripting library (and thus Dictionaries) is not available in OS X. A workaround is to use Patrick O’Beirne’s Dictionary Class: https://sysmod.wordpress.com/2011/11/02/dictionary-class-in-vba-instead-of-scripting-dictionary/

This works more or less painlessly, but there are a few caveats, such as the Add method of Patrick’s Dictionary Class (DC) expecting the key as a String, not a Variant.

(Note: I haven’t managed to get DC working properly in Office 2016—it keeps complaining about type mismatches and I can’t figure out where they’re coming from. It works in Office 2011.)




2.

The code used for Application.OrganizerDelete will not work as posted. The variable docPath is set to ActiveDocument.Path & "\" & ActiveDocument.Name, which won’t work for two reasons.

First off, a hard-coded backslash will be Windows-only—the better way to do it is the way sFilePath is defined further up in the code, by using Application.PathSeparator (it will be “:” on a Mac, not “\”).

Secondly, at least on a Mac, ActiveDocument.Path already contains the entire path including the name, so adding an extra path separator and document name will yield a path to a nonexistent file (“computer:Users:Username:Documents:DocumentName.docx:DocumentName.docx”, for example).




You’ll have to tinker with it a good deal to get it to work on Office for Mac.
Jason Morris    29 Nov 2015, 19:34
Ooops! Yes, indeed.
Thanks again Ken.
Ken Endacott    29 Nov 2015, 06:50
Jason

I think that the reason objStyle.Namelocal is evaluating incorrectly is that you have declared
Dim objStyle as Object

rather than
Dim objStyle as Style

If you declare variables as Object or Variant, Word gives the variable a suitable attribute the first time the variable is used. I suspect that during your testing somehow objStyle had acquired a different attribute that remained during further testing.

Anyway, your solution has fixed the problem.

Jason Morris    29 Nov 2015, 01:44
Hi Ken,

For some reason, the Name:=objStyle.NameLocal field keeps evaluating to "Microsoft Word" in your code running on a Word 2010 document in Word 2010.

By simply substituting the key value of the loop (below), the new delete code worked.

Application.OrganizerDelete Source:=docPath, _
  name:=key, Object:=wdOrganizerObjectStyles

The complete new listing is given below with debug statements removed and your fix included.

Cheers,
Jason

==================== BEGIN CODE =============================

Sub RemoveDeadStyles()

On Error GoTo ErrorHandler

Const MAX_SAVE_WAIT As Integer = 50 ' # deletes between saves
Const MAX_UNDO_WAIT As Integer = 20 ' # deletes between undo buffer purges

Dim i As Long

Dim pCount As Integer
Dim changeCounter As Integer
Dim activeStyleCount As Integer

Dim sName As String

Dim dicAllStyleNames As Scripting.Dictionary
Dim dicUsedStyleNames As Scripting.Dictionary

Set dicAllStyleNames = CreateObject("scripting.dictionary")
Set dicUsedStyleNames = CreateObject("scripting.dictionary")

Dim colParagraphs As Word.paragraphs
Dim colActiveStyles As Word.Styles

Dim pStyleObj As Style

Dim p As paragraph

Dim objStyleName As Variant
Dim uniqueUsedStyles As Variant

Dim objStyle As Object

Set colActiveStyles = ActiveDocument.Styles
Set colParagraphs = ActiveDocument.paragraphs

activeStyleCount = colActiveStyles.Count
pCount = colParagraphs.Count

Dim sFilePath As String
sFilePath = ActiveDocument.Path & Application.PathSeparator & ActiveDocument.name

' Get all ACTIVE style names as strings

Word.System.Cursor = wdCursorWait
Word.StatusBar = "Scanning document for all ACTIVE style names.."

For i = 1 To colActiveStyles.Count
    Set objStyle = colActiveStyles.Item(i)
    sName = objStyle.NameLocal
    dicAllStyleNames.Add sName, ""
    Set objStyle = Nothing
    Word.StatusBar = "Scanning document for all ACTIVE style names.." & "Adding style[" & i & "]=" & sName
Next

Word.StatusBar = "dicAllStyleNames count: " & dicAllStyleNames.Count


' Scan document paragraphs for all USED styles and get names

Word.StatusBar = "Scanning document paragraphs for all USED style names.."

Dim localName As String

For i = 1 To pCount
    Set p = colParagraphs.Item(i)
    Set objStyle = p.Style
    
    If Not objStyle Is Nothing Then
        localName = objStyle.NameLocal
        dicUsedStyleNames.Add localName, ""
        Word.StatusBar = "Scanning document paragraphs for all USED style names.. Adding " & localName
    End If
    
    Set p = Nothing
    Set objStyle = Nothing
Next i

Word.StatusBar = "dicUsedStyleNames size:" & dicUsedStyleNames.Count

Dim usedStyleKeys As Variant
Dim key As Variant
usedStyleKeys = dicUsedStyleNames.Keys

' Remove used styles from all styles collection

For Each key In usedStyleKeys
    Word.StatusBar = "Filtering used style: " & key
    dicAllStyleNames.Remove key
Next

Word.StatusBar = "All remaining styles count: " & dicAllStyleNames.Count


' Remove all dead styles

changeCounter = 0

Dim newKeys As Variant
Dim docPath As String

docPath = ActiveDocument.Path & "\" & ActiveDocument.name
newKeys = dicAllStyleNames.Keys

For Each key In newKeys

    Set objStyle = ActiveDocument.Styles.Item(key)
    
    If objStyle.BuiltIn = False Then
        Word.StatusBar = "Removed style: " & key
        
        ' Obsolete approach
        'objStyle.Delete
                
        'Application.OrganizerDelete Source:=docPath, name:=objStyle.NameLocal, Object:=wdOrganizerObjectStyles
        Application.OrganizerDelete Source:=docPath, name:=key, Object:=wdOrganizerObjectStyles
        
        changeCounter = changeCounter + 1
    End If
    
    Set objStyle = Nothing
    
    ' You want to save frequently enough that incremental changes are preserved
    ' but not so fast that you slow the macro. Also you want to purge the
    ' undo buffer but not before it has filled up enough to cause a performance
    ' problem. This macro impl uses the MAX_SAVE_WAIT value as a compromise.
    
    If (changeCounter > 0) And ((changeCounter Mod MAX_SAVE_WAIT) = 0) Then
        Word.StatusBar = "Saving changes..."
        ActiveDocument.Save
        DoEvents
        ActiveDocument.UndoClear
    End If
    
Next key

MsgBox "All unused styles removed OK!" & vbCrLf & "New Style Count: " & ActiveDocument.Styles.Count, vbOKOnly
Word.StatusBar = "All unused styles removed OK!" & " New Style Count: " & ActiveDocument.Styles.Count

Word.System.Cursor = wdCursorNormal


Exit Sub
ErrorHandler:
    'Debug.Print "ERROR: " & Err.Description & " Err Num = " & Err.Number & " " & Err.Source
    If (Err.Number = 457) Then
        Resume Next
    ElseIf (Err.Number = 6015) Then
        Word.StatusBar = "Closing on corruption error. Reopen and fix."
        ActiveDocument.Close (True)
        DoEvents
    ElseIf (Err.Number = 4605) Then
          Resume Next
    End If
End Sub

==================== END CODE =============================
Jason Morris    28 Nov 2015, 23:01
Hi Ken,
A nice improvement!

I was happy just to get the bloody thing to work! I had a 300 page thesis that was utterly wrecked with thousands of unused styles.

I will post an updated solution.

Cheers,
Jason
Ken Endacott    02 Nov 2015, 06:28
Jason
Your method of using the scripting dictionary object is efficient for determining unused styles. However, to delete styles you use the very inefficient statement:
 objStyle.Delete

A much better statement is:
Application.OrganizerDelete Source:=docPath, _
        Name:=objStyle.NameLocal, Object:=wdOrganizerObjectStyles

Where docPath is set outside the loop to:
docPath = ActiveDocument.Path & "\" & ActiveDocument.Name

On a sample document that has 757 total styles of which 461 are unused, your macro took 567 seconds. The modified macro with the more efficient delete took 51 seconds.
Jason Morris    01 Nov 2015, 17:38
What many of these solutions do is scan the document one time for a each style. This is terribly inefficient for large documents and large numbers of styles. A more efficient approach is to use the scripting Dictionary object and its ability to enforce unique keys. I propose the following solution:

1. Get a collection of all active styles in the document (1st pass).
2. Get a collection of all used styles in the document by checking each paragraph (2nd pass).
3. For each element of the used styles, if it's not a built-in style, then eliminate it from the active collection. The remaining collection is the set of totally unused styles to be deleted.
4. Delete this collection.

WARNING: This can be a long-running process for big documents with many paragraphs and/or many styles. Switch to immediate mode to see progress.

Sub RemoveDeadStyles()

On Error GoTo ErrorHandler

Dim i As Long
Dim pCount As Integer

Dim sName As String

Dim dicAllStyleNames As Scripting.dictionary
Dim dicUsedStyleNames As Scripting.dictionary

Set dicAllStyleNames = CreateObject("scripting.dictionary")
Set dicUsedStyleNames = CreateObject("scripting.dictionary")

Dim colParagraphs As word.Paragraphs
Dim colActiveStyles As word.Styles

Dim activeStyleCount As Integer

Dim pStyleObj As Style

Dim p As Paragraph

Dim objStyleName As Variant
Dim objStyle As Object
Dim uniqueUsedStyles As Variant

Set colActiveStyles = ActiveDocument.Styles
Set colParagraphs = ActiveDocument.Paragraphs

activeStyleCount = colActiveStyles.Count
pCount = colParagraphs.Count

Debug.Print "Active Style Count: " & activeStyleCount
Debug.Print "Paragraph Count: " & pCount

' Get all ACTIVE style names as strings
For i = 1 To colActiveStyles.Count
    Set objStyle = colActiveStyles.Item(i)
    sName = objStyle.NameLocal
    dicAllStyleNames.Add sName, ""
    Set objStyle = Nothing
    Debug.Print "Adding style[" & i & "]=" & sName
    DoEvents
Next

Debug.Print "=================================================="
Debug.Print "All active style names scanned OK..."
Debug.Print "dicAllStyleNames count: " & dicAllStyleNames.Count

' Scan document paragraphs for all USED styles and get names
For i = 1 To pCount
    Set p = colParagraphs.Item(i)
    Set objStyle = p.Style
    
    If Not objStyle Is Nothing Then
        dicUsedStyleNames.Add objStyle.NameLocal, ""
    End If
    Set p = Nothing
    Set objStyle = Nothing
    DoEvents
Next i


Debug.Print "=================================================="
Debug.Print "All used paragraph style names scanned OK..."
Debug.Print "dicUsedStyleNames size:" & dicUsedStyleNames.Count


Dim usedStyleKeys As Variant
Dim key As Variant
usedStyleKeys = dicUsedStyleNames.Keys

' Remove used styles from all
For Each key In usedStyleKeys
    dicAllStyleNames.Remove key
    DoEvents
Next

Debug.Print "=================================================="
Debug.Print "All unique used style names removed from all names OK..."
Debug.Print "All remaining styles count: " & dicAllStyleNames.Count

i = 0

' Get the new keys
Dim newKeys As Variant
newKeys = dicAllStyleNames.Keys

' Remove the dead styles
For Each key In newKeys

    Set objStyle = ActiveDocument.Styles.Item(key)
    
    If objStyle.BuiltIn = False Then
        Debug.Print "Removing " & objStyle
        objStyle.Delete
    End If
    
    Set objStyle = Nothing
    
    i = i + 1
       
    ' Clear the undo buffer
    If ((i Mod 25) = 0) Then
    ActiveDocument.UndoClear
    Debug.Print vbTab & vbTab & "Cleared undo buffer..."
    End If
    
    DoEvents

Next key


Debug.Print "================================================"
Debug.Print "All unused styles removed OK!"
Debug.Print "New Style Count: " & ActiveDocument.Styles.Count
Debug.Print "================================================"


Exit Sub
ErrorHandler:
    Debug.Print "ERROR: " & Err.Description & " Err Num = " & Err.Number & " " & Err.Source
' This is the error that the key already exists... just swallow that.
    If (Err.Number = 457) Then
        Resume Next
    End If
End Sub

Ken Endacott    25 Jun 2015, 09:05
Toby. Your macro does not look at style usage in other than the main story and hence may remove styles that are in use.

The following is a macro that will check for style usage in all story parts of the document. Rather than look at the style of every paragraph it uses Find to see if each custom style is used at least once. This is quicker on large documents.

Sub DeleteUnusedStyles()
Dim oRange As Range
Dim aRange As Range
Dim styy As Style
Dim sName As String
Dim docPath As String
Dim Customstyle() As String
Dim j As Long
Dim jj As Long
Dim k As Long

  ' build array of custom styles
  ReDim Customstyle(0)
  j = -1
  For Each styy In ActiveDocument.Styles
    With styy
      If Not .BuiltIn And .Type <> wdStyleTypeTable And _
         .Type <> wdStyleTypeList Then
        j = j + 1
        ReDim Preserve Customstyle(j)
        Customstyle(j) = .NameLocal
      End If
    End With
  Next styy
  If j < 0 Then
    MsgBox "No custom styles"
    Exit Sub
  End If
  
  ' remove custom style from array if it is used
  For Each oRange In ActiveDocument.StoryRanges
    jj = 0
    Do
       Set aRange = oRange.Duplicate
       With aRange.Find
         .ClearFormatting
         .Style = Customstyle(jj)
       End With
       If aRange.Find.Execute(FindText:="", replacewith:="", MatchCase:=False, Wrap:=wdFindStop, _
          MatchWholeWord:=False, Forward:=False, Replace:=wdReplaceNone) Then
         For k = jj To j - 1
           Customstyle(k) = Customstyle(k + 1)
         Next k
         j = j - 1
       Else
         jj = jj + 1
       End If
    Loop Until jj > j
  Next oRange
  
  If j < 0 Then
    MsgBox "All custom styles are in use"
    Exit Sub
  Else
    If MsgBox("There are " & j + 1 & " unused custom styles. Remove them?", vbYesNo) = vbNo Then Exit Sub
  End If
  ' Delete custom styles that left in array
  docPath = ActiveDocument.Path & "\" & ActiveDocument.Name
  For k = 0 To j
     Application.OrganizerDelete Source:=docPath, _
        Name:=Customstyle(k), Object:=wdOrganizerObjectStyles
  Next k

End Sub
Toby    24 Jun 2015, 10:40
To go with my previous comment. This is the macro we use:

Sub StyleBloatFix()
    Dim StyleList As Collection
    Dim ActiveParagraph As Paragraph
    Dim ActiveTable As Table
    Dim ActiveStyle As Style
    Dim exists As Boolean
    Dim x As Long
    
    On Error Resume Next
    
    Set StyleList = New Collection
    
    For Each ActiveParagraph In ActiveDocument.Paragraphs
        exists = False
        
        For x = 1 To StyleList.Count
            If ActiveParagraph.Style.NameLocal = StyleList(x) Then
                exists = True
                Exit For
            End If
        Next
        
        If Not exists Then
            StyleList.Add Item:=ActiveParagraph.Style.NameLocal
        End If
    Next ActiveParagraph
    
    For Each ActiveTable In ActiveDocument.Tables
        exists = False
        
        For x = 1 To StyleList.Count
            If ActiveTable.Style.NameLocal = StyleList(x) Then
                exists = True
                Exit For
            End If
        Next
        
        If Not exists Then
            StyleList.Add Item:=ActiveTable.Style.NameLocal
        End If
    Next ActiveTable
    
    For Each ActiveStyle In ActiveDocument.Styles
        exists = False
        
        If Not ActiveStyle.BuiltIn Then
            For x = 1 To StyleList.Count
                If ActiveStyle.NameLocal = StyleList(x) Then
                    exists = True
                    Exit For
                End If
            Next
            
            If Not exists Then
                
                Application.OrganizerDelete Source:=ActiveDocument.Path & "\" & ActiveDocument.name, name:=ActiveStyle.NameLocal, _
                    Object:=wdOrganizerObjectStyles
            End If
        End If
    Next ActiveStyle
End Sub

This will:
loop through all paragraphs and create a list of used styles
loop through all tables and create a list of used styles
Loop through all styles in the document and checking if they are on the list
If they are not, delete the style from the document using the organizer
Toby    24 Jun 2015, 10:30
We have actually Identified a bug in MS word. When you run your macro, whether or not the styles are being removed from the style list, they are not being removed from the document; at least, not 100% of the time. Depending on the circumstances your macro can result in a style bloat issue where the styles.xml file of the document blows up.

Open a new document and save it to your desktop. Change the extension to a .zip from a .docx and open the word folder within the zip file. The uncompressed styles.xml file will be rather low.

Now change the extension back to .docx, run the macro and check the uncompressed styles.xml file. For us it usually goes from 15kb to ~ 400kb.

This is because even though you are only comparing strings, word pulls the definition of the style into the document as a frame of reference, then it removes the style from your styles list but leaves the definition in the xml.
Red Kelpie    24 Jun 2015, 01:30
Hmm, unfortunately the macro seems to delete table styles that are in use.

Any idea how to check whether table styles are being used?
Ken Endacott    11 Apr 2015, 18:32
Viktor

I cannot replicate your problem in Word2010.

What version of Word are you using?
Viktor    10 Apr 2015, 06:12
For me, it exits with "item with specified name does not exist" when it tries to set

.Style = oStyle.NameLocal

if namelocal points to an alias that is not really a style name, e.g. "Body text (2) + Arial,7.5 pt,Bold"

How to overcome this please?
Pip    12 Mar 2015, 07:57
Absolutely Brilliant - thankyou!
Ken Endacott    04 Mar 2015, 00:49
Documents can accumulate styles and it is not uncommon for a document to have 200 unused custom styles. The oStyle.Delete method has problems if more than a few styles are to be deleted and can take up to 30 minutes to delete 100 styles.

The solution is to use the style organizer which will reduce the time to a few seconds. Instead of oStyle.Delete use:

Application.OrganizerDelete Source:= _
ActiveDocument.Path & "\" & ActiveDocument.Name, _
        Name:=oStyle.NameLocal, Object:=wdOrganizerObjectStyles
Allen    19 Feb 2015, 17:23
TC: You can't get rid of built-in styles; they are permanently built-in.

If you use a macro to "delete" a built-in style or you try to delete one manually, all it does is remove any changes you previously made to that style, returning it to the built-in defaults for that style. The style itself is never deleted.

-Allen
tc    19 Feb 2015, 15:19
Actually the KnowledgeBase Article doesn't tell you how to get rid of default built in styles.
Jason    27 Nov 2014, 02:17
This worked perfectly - thanks
Pica_pau    22 Oct 2014, 12:16

  Save it as .RTF, then close it, then open the .RTF in MS Word, and save it again in .DOC format.

  Worked with me!

  Regards!
coba    27 Sep 2014, 15:09
Hello. I would like to delete a style that was created by me, not a built-in style. I have tried in 2-3 different ways, but I only manage to remove it from the quick list and only for the document that is open at the time. It appears again in the quick list when I open a new document. Have you got a tip for completely deleting a created style in Word 2007? Thanks very much in advance!
alex    22 Aug 2014, 18:34
My word 2007 was not able to find ActiveDocument.Content.Find.Style property when used with a String type variable. I had to use a CVar() cast for it to work. I hope this helps other people.

Sub DeleteUnusedStyles()
    Dim oStyle As Style
    
    For Each oStyle In ActiveDocument.Styles
        'Only check out non-built-in styles
        If oStyle.BuiltIn = False Then
            With ActiveDocument.Content.Find
                .ClearFormatting
                .Style = CVar(oStyle.NameLocal)
                .Execute FindText:="", Format:=True
                If .Found = False Then oStyle.Delete
            End With
        End If
    Next oStyle
End Sub
Arthemise    27 Jun 2014, 09:02
Thanks so much. This is exactly what I need.
Siva    23 Jun 2014, 07:29
This was useful but its not suitable for vast type files.
 
 

Our Company

Sharon Parq Associates, Inc.

About Tips.Net

Contact Us

 

Advertise with Us

Our Privacy Policy

Our Sites

Tips.Net

Beauty and Style

Cars

Cleaning

Cooking

DriveTips (Google Drive)

ExcelTips (Excel 97–2003)

ExcelTips (Excel 2007–2016)

Gardening

Health

Home Improvement

Money and Finances

Organizing

Pests and Bugs

Pets and Animals

WindowsTips (Microsoft Windows)

WordTips (Word 97–2003)

WordTips (Word 2007–2016)

Our Products

Helpful E-books

Newsletter Archives

 

Excel Products

Word Products

Our Authors

Author Index

Write for Tips.Net

Copyright © 2016 Sharon Parq Associates, Inc.