Deleting unused styles

[larrysulky]

Hi, All--

There's a mess of good info here, and on websites, and particularly on
MVPS, about deleting unused styles. I put together a macro using the
various ideas but I can't seem to get it running quite right (WinXP,
Word2003):

1) Re: Deleting unused but unimportant built-in styles: Forget it. The
macro won't do it. For that matter, the user interface won't do it
either.

2) Re: "styles in use" category under Styles and Formatting => Custom
=> Styles: Useless. A pack of lies.

3) Re: Deleting styles in floating textboxes: this is the kicker. These
documents have lots of textboxes and lots of styles. I try to use a
simple Find command to find content with each style listed in the
active document's style list, but Find within VBA seems unable to
consistently find content in boxes even though when Find is run from
the interface it has no problem. The result is that lots of styles are
flagged as "unused" even though I can look right at them being used.

Here's the macro (with big blocks of comments excised to save space).
Anybody have any suggestions? TIA...

~~~~~~~~~~~~~~~~~~~~~~~~~
Sub DeleteUnusedStyles() ' Much of this was nicked from an MVP site.

Dim myStyle As Style
Dim myDeletePrompt As String

Dim rngStory As Word.Range
Dim lngJunk As Long
Dim myFlagFoundStyle As Boolean ' True when style truly appears to be
in use.

Selection.HomeKey Unit:=wdStory ' Is this necessary?

For Each myStyle In ActiveDocument.Styles
myFlagFoundStyle = False
If (myStyle.BuiltIn = True) Then
'' Protect all built-in styles until I get everything else
working.
myFlagFoundStyle = True
End If
If (myFlagFoundStyle = False) Then

lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
' ... Something about a header bug?
'Selection.HomeKey Unit:=wdStory ' Is this necessary?

'Iterate through all story types in the current document
For Each rngStory In ActiveDocument.StoryRanges

rngStory.Find.ClearFormatting
rngStory.Find.Replacement.ClearFormatting
With rngStory.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Style = ActiveDocument.Styles(myStyle.NameLocal)
End With

'Iterate through all linked stories
Do
If (rngStory.Find.Execute) Then
myFlagFoundStyle = True
End If

Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing

Next
End If

If (Not myFlagFoundStyle) Then
myDeletePrompt = "Delete unused user style?"
Select Case MsgBox(myDeletePrompt, vbYesNoCancel + vbInformation,
myStyle.NameLocal)
Case vbYes
myStyle.Delete
Case vbCancel
GoTo bye
End Select
End If
Next myStyle

bye:

End Sub

 

[Jezebel]

An alternative approach is to iterate all the content of the document,
making a list of all the styles actually used. Then iterate the styles
collection and delete all that aren't in your list. Just ignore the error on
the built-ins (and yes, you're stuck with the damned things).

Separately, you don't need "Selection.HomeKey Unit:=wdStory" before using
the Find command if you're using Find on a Range object. Moving to the start
of the document is necessary only if you're doing a Selection.Find
(downwards).

 

[Greg Maxey]

You might try a visit to:

http://gregmaxey.mvps.org/Style_Report.htm

 

[larrysulky]

You might try a visit to:

http://gregmaxey.mvps.org/Style_Report.htm

Thanks, Greg. I stole most of it from there <blush/>.

 

[larrysulky]

An alternative approach is to iterate all the content of the document,
making a list of all the styles actually used. Then iterate the styles
collection and delete all that aren't in your list. Just ignore the error on
the built-ins (and yes, you're stuck with the damned things).

I don't think I understand how to iterate through the content. Would I
grab every character one by one (this has to work for character styles
as well as paragraph styles)?

Also, since VBA doesn't have the concept of an associative array (AKA
"hash table"), how would I look for matching styles in my list? Could I
make the style list a long string with delimiters between style names?
(The files are likely to have around 300 styles in them, with user
style names averaging 15 letters long or so ... could be a very long
string).

Or would I just have to examine every entry in my array one by one for
each style in the style collection? If I have 150 styles actually in
use out of 300 in the style collection, that would require 150 x 300 =
45,000 inspections.

I'm not saying your suggestion won't work, Jezebel; on the contrary, I
think it will, but I'm not smart enough to see how yet.

Separately, you don't need "Selection.HomeKey Unit:=wdStory" before using
the Find command if you're using Find on a Range object. Moving to the start
of the document is necessary only if you're doing a Selection.Find
(downwards).

Thanks, that did seem fishy to me.

--larry

 

[Greg Maxey]

Ah, an honest theif ;-)

 

[larrysulky]

I think I figured out how to do what Jezebel was suggesting, and it
does work. It's a little slow, but not terrible, and certainly better
than doing this manually. It seems to reliably find every style on
every character of text everywhere. Here's my code:

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Sub DeleteUnusedStyles() ' Much of this was nicked from an MVP site,
plus VBA Google groups.

' IMPORTANT: Set Tools > References to include library: Microsoft
Scripting Runtime
Dim docStyles As New Scripting.Dictionary ' The long-sought hash
table capability.

Dim myStyle As Style
Dim rngStory As Word.Range

Dim lngJunk As Long ' Still not sure that I really need this.
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType

For Each rngStory In ActiveDocument.StoryRanges
Do

For Each myText In rngStory.Paragraphs
' Make sure we get para styles even if they are completely
' masked by char styles. Rare, but it does happen.
If Not (docStyles.Exists(myText.Style.NameLocal)) Then
docStyles.Add myText.Style.NameLocal, 1
End If
Next myText

'For Each myText In rngStory.Words ' Word-wise granularity
isn't good enough.
For Each myText In rngStory.Characters ' This will take a
while *sigh* .
If Not (docStyles.Exists(myText.Style.NameLocal)) Then
docStyles.Add myText.Style.NameLocal, 1
End If
Next myText

Set rngStory = rngStory.NextStoryRange

Loop Until rngStory Is Nothing
Next

For Each myStyle In ActiveDocument.Styles
If (myStyle.BuiltIn = False) And Not
(docStyles.Exists(myStyle.NameLocal)) Then
'StatusBar = "Deleted " & myStyle.NameLocal
myStyle.Delete ' Just delete the blighters; there are too
many to check each one.

'Select Case MsgBox("Delete unused user style?",
vbYesNoCancel + vbInformation, myStyle.NameLocal)
' Case vbYes
' myStyle.Delete
' Case vbCancel
' GoTo bye
'End Select
End If
Next

bye:
MsgBox "Done!", , "Delete Unused Styles"
End Sub