Removing Unused Styles

by Allen Wyatt
(last updated May 3, 2014)

34

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.

Author Bio

Allen Wyatt

With more than 50 non-fiction books and numerous magazine articles to his credit, Allen Wyatt is an internationally recognized author. He  is president of Sharon Parq Associates, a computer and publishing services company. ...

MORE FROM ALLEN

Changing Default Languages

Modifying the default language used by Word.

Discover More

Searching for Paragraph Marks and Line Breaks

Word allows you to search not for special characters that normally do not print such as paragraph marks and line breaks.

Discover More

Handling Negative Numbers in a Complex Custom Format

Custom formats are great for defining how a specific value in a cell should look. They aren't that great at doing complex ...

Discover More

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!

More WordTips (menu)

Finding Unused Styles

Use this VBA macro to determine which styles are being used in the current Word document.

Discover More

Printing a Full Style Sheet

Word supports the use of styles (they are very powerful), but it doesn't provide a way to get a full-featured style sheet ...

Discover More

Numbering on New Paragraph Doesn't Work as Expected

The Numbering feature in Word can be a bit tricky to navigate. Sometimes it works as it should, and other times it seems to ...

Discover More
Subscribe

FREE SERVICE: Get tips like this every week in WordTips, a free productivity newsletter. Enter your address and click "Subscribe."

View most recent newsletter.

Comments

If you would like to add an image to your comment (not an avatar, but an image to help in making the point of your comment), include the characters [{fig}] in your comment text. You’ll be prompted to upload your image when you submit the comment. Maximum image size is 6Mpixels. Images larger than 600px wide or 1000px tall will be reduced. Up to three images may be included in a comment. All images are subject to review. Commenting privileges may be curtailed if inappropriate images are posted.

What is two more than 4?

2017-11-27 22:21:58

Jacob

Unfortunately this also deletes any header and footer styles and styles that are in textboxes. I can't come up with a workaround for this.


2017-08-27 11:47:46

John Mark Seiver

Allen,
This macro worked like a charm. Thank you so much!
John Seiver


2017-07-27 09:43:42

John

@Judi Pillsbury: The styles to be deleted are listed in StylesArray. You may either operate on StylesArray directly (create a dialog where you can check the styles to be [not] deleted) or include a user request just before deleting the individual style, i.e. line

If StyleStatus(k) = False Then
Application.OrganizerDelete Source:=docPath, _
Name:=StyleArray(k), Object:=wdOrganizerObjectStyles
End If


2017-07-27 09:38:24

John

@Ken Endacott: There is a backslash missing in your code:

docPath = ActiveDocument.Path & "" & ActiveDocument.Name

should read

docPath = ActiveDocument.Path & chr(92) & ActiveDocument.Name

(I expect, this is a character checking and stripping problem of the webserver. To circumvent this, I coded the backslash. Instead of "chr(92)" a simple backslash may be included between the quotation marks.)


2017-06-25 16:32:52

Judi Pillsbury

Is there a way to run this - or a similar - macro and select which styles to delete without deleting all unused styles?


2016-11-17 18:39:17

Julian D. A. Wiseman

Thank you. I will read that this weekend, and then use it.


2016-11-17 06:45:22

Ken Endacott

Julian. The following subroutine DeleteUnusedStyles uses your suggested method to check for base styles and then delete unused styles. To determine if a style is used in a document I have used a variation on code, suggested by Greg Maxey, to search every part of a document including text frames in shapes (including textboxes) given in http://word.mvps.org/faqs/customization/ReplaceAnywhere.htm

The code is reasonably efficient, on a 505 page document with 116 custom styles of which 92 were unused, it took 150 seconds to build up a list of styles to be deleted then 97 seconds to delete the 92 styles. On a 145 page document with 33 unused styles out of 54 the times were 34 seconds and 11 seconds.

I hope that it will run on your Mac as it has some work arounds to overcome bugs in VBA.

Now for my gripes about VBA.
1. The Styles pane in Word has an option to display only styles used in the document but it is not possible to access this list in VBA. It would simplify the macro and speed things up considerably.
2. Find in VBA works differently from manual Find and a macro recorded from the manual Find will give different results than the actions that created the macro. Manual Find searches all of the document at once but VBA Find searches only the text in the current story. Furthermore, it does not search in textboxes unless you individually search the contents of each text box.
3. With collections it is not possible to read the key of a collection item. The work around is to construct a parallel array of keys. A small issue, but annoying.
4. The Style.Delete is very inefficient and if used to delete 92 styles results in a blow out of the time from about 1.5 minutes to 30 minutes. Instead the poorly documented Application.OrganizerDelete method is used.

Sub DeleteUnusedStyles()
Dim CustomStyles As New Collection
Dim StyleStatus() As Boolean
Dim StyleArray() As String
Dim aStyle As Style
Dim refStyle As String
Dim k As Long
Dim j As Long
Dim s As String
Dim docPath As String
Dim sCount As Long
Dim loopTest As Boolean

' create collection of custom styles -------------
ReDim StyleArray(0)
k = 0
For Each aStyle In ActiveDocument.Styles
If Not aStyle.BuiltIn Then
k = k + 1
j = CustomStyles.Count
On Error Resume Next
CustomStyles.Add Item:=k, Key:=aStyle.NameLocal
If j = CustomStyles.Count Then
k = k - 1
Else
ReDim Preserve StyleArray(k)
StyleArray(k) = aStyle.NameLocal
End If
End If
On Error GoTo 0
Next aStyle

' First pass. Flag used styles -----------------------
sCount = CustomStyles.Count
ReDim StyleStatus(CustomStyles.Count)
For k = 1 To sCount
StyleStatus(k) = CheckStyleUse(StyleArray(k))
Next k

' subsequent passes. loop until there are no changes -------------------
Do
loopTest = True
For k = 1 To sCount
If StyleStatus(k) Then
On Error Resume Next
refStyle = ActiveDocument.Styles(CustomStyles(k)).BaseStyle.NameLocal
j = 0
j = CustomStyles(refStyle)
If j > 0 Then
If StyleStatus(j) = False Then
StyleStatus(j) = True
loopTest = False
End If
End If
End If
Next k
Loop Until loopTest
On Error GoTo 0

' delete styles that are not used and are not base styles
j = 0
s = ""
For k = 1 To sCount
If StyleStatus(k) = False Then
j = j + 1
s = s & StyleArray(k) & vbCrLf
End If
Next k
s = Str(j) & " styles to be deleted from " & Str(sCount) & vbCrLf & s

If MsgBox(s, vbOKCancel) = vbOK Then
docPath = ActiveDocument.Path & "" & ActiveDocument.Name
For k = 1 To sCount
If StyleStatus(k) = False Then
Application.OrganizerDelete Source:=docPath, _
Name:=StyleArray(k), Object:=wdOrganizerObjectStyles
End If
Next k
End If
End Sub

Function CheckStyleUse(styName As String) As Boolean
Dim aRange As Range
Dim aShape As Shape
Dim m As Long
CheckStyleUse = False
m = ActiveDocument.Sections(1).Headers(1).Range.StoryType
For Each aRange In ActiveDocument.StoryRanges
Do
If FindStyleInRange(aRange, styName) Then
CheckStyleUse = True
Exit Function
End If
' check any textboxes in story
On Error Resume Next
Select Case aRange.StoryType
Case 6, 7, 8, 9, 10, 11
If aRange.ShapeRange.Count > 0 Then
For Each aShape In aRange.ShapeRange
If aShape.TextFrame.HasText Then
If FindStyleInRange(aShape.TextFrame.TextRange, styName) Then
CheckStyleUse = True
Exit Function
End If
End If
Next
End If
End Select
Set aRange = aRange.NextStoryRange
Loop Until aRange Is Nothing
Next aRange
On Error GoTo 0
End Function

Function FindStyleInRange(aRange As Range, styName As String) As Boolean
With aRange.Find
.ClearFormatting
.Style = styName
.Text = ""
.Replacement.Text = ""
.Wrap = wdFindContinue
FindStyleInRange = .Execute
End With
End Function


2016-11-14 16:26:25

Julian D. A. Wiseman

My first method was slower than necessary.

• Create an array of all non-built-in styles.
• Create a same-length Boolean array, defaulting to False.
• For Each st in styles.
•• If st used, loop forever:
••• Mark st as True
••• If st has no ancestor then Exit Loop forever else st = Ancestor(st);
•• End Loop forever
•• Next st
• Delete all styles still False.

If you write this (Mac Word doesn’t show object model, so writing it would be painful for me), please share.


2016-11-13 06:29:10

Ken Endacott

Julian
I have been using an elaborate method to ensure that ancestor styles of active styles are not deleted but your suggestion is a more elegant way of handling chained dependencies.


2016-11-12 18:36:55

Julian D. A. Wiseman

What if a style is not used directly, but another style is based-on this unused style? It seems that DeleteUnusedStyles() would delete this ancestor style, but shouldn’t.

An algorithm might proceed as follows.
• Create an array of all non-built-in styles.
• Create a same-length Boolean array, defaulting to False.
• Make all used styles as True.
• Mark the immediate ancestor of all True styles as True. Repeat until this ceases to cause any changes.
• Delete all False styles.


2016-07-15 03:11:49

Daniel

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


2016-06-28 06:04:23

Janus

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.


2015-11-29 19:34:28

Jason Morris

Ooops! Yes, indeed.
Thanks again Ken.


2015-11-29 06:50:38

Ken Endacott

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.


2015-11-29 01:44:13

Jason Morris

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 =============================


2015-11-28 23:01:17

Jason Morris

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


2015-11-02 06:28:25

Ken Endacott

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.


2015-11-01 17:38:30

Jason Morris

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


2015-06-25 09:05:14

Ken Endacott

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


2015-06-24 10:40:52

Toby

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


2015-06-24 10:30:02

Toby

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.


2015-06-24 01:30:40

Red Kelpie

Hmm, unfortunately the macro seems to delete table styles that are in use.

Any idea how to check whether table styles are being used?


2015-04-11 18:32:28

Ken Endacott

Viktor

I cannot replicate your problem in Word2010.

What version of Word are you using?


2015-04-10 06:12:20

Viktor

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?


2015-03-12 07:57:05

Pip

Absolutely Brilliant - thankyou!


2015-03-04 00:49:17

Ken Endacott

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


2015-02-19 17:23:01

Allen

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


2015-02-19 15:19:28

tc

Actually the KnowledgeBase Article doesn't tell you how to get rid of default built in styles.


2014-11-27 02:17:51

Jason

This worked perfectly - thanks


2014-10-22 12:16:17

Pica_pau


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!


2014-09-27 15:09:46

coba

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!


2014-08-22 18:34:51

alex

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


2014-06-27 09:02:20

Arthemise

Thanks so much. This is exactly what I need.


2014-06-23 07:29:32

Siva

This was useful but its not suitable for vast type files.


This Site

Got a version of Word that uses the menu interface (Word 97, Word 2000, Word 2002, or Word 2003)? This site is for you! If you use a later version of Word, visit our WordTips site focusing on the ribbon interface.

Newest Tips
Subscribe

FREE SERVICE: Get tips like this every week in WordTips, a free productivity newsletter. Enter your address and click "Subscribe."

(Your e-mail address is not shared with anyone, ever.)

View the most recent newsletter.