Style in Use Macro-Need Help Optimizing Code

freda0255 · #1 07-31-2014, 10:00 PM

I found and modified a macro that displays the styles that are really in use in a document.

As I understand it, Word's built-in command to display "styles in use" will display a style if the style was ever in use in a document, even if the style is not currently in use.

I am asking for help in making the macro run faster. The goal is to make it easier for users to select the styles they need by cleaning up the style pane. The users at my company will need to run the macro many times per day. Currently, the macro takes about 30 seconds to run on a 10 page document.

Thank you for your assistance.

Freda

Code:

Sub StylesInUseForReal() 
    Dim oStyle As Style 
    Dim sStyle As String 
    Dim actDoc As Document 
    Dim newDoc As Document 
    Dim sect As section 
    Dim rng As Range 
    Dim sName As String 
    Set actDoc = ActiveDocument 
    sName = actDoc.FullName 
    StatusBar = "Analyzing syles in use! Please be patient! This may take some time." & _ 
    "Hit Ctrl-Break to stop the macro." 
    On Error Resume Next 
    For Each oStyle In actDoc.Styles 
        If oStyle.InUse And IsStyleInUseInDoc(oStyle, actDoc) Then 
            oStyle.Visibility = False 
        End If 
    Next oStyle 
    StyleShowStyleInUse 
    MsgBox "Styles in Use Macro is Complete." 
End Sub 
 
Function IsStyleInUseInDoc(ByVal oStyle As Style, ByVal oDoc As Document) As Boolean 
    Dim oRange As Range 
    Dim bReturn As Boolean 
    bReturn = False 
    For Each oRange In oDoc.StoryRanges 
        If IsStyleInRange(oStyle, oRange) = True Then 
            bReturn = True 
        End If 
    Next oRange 
    IsStyleInUseInDoc = bReturn 
End Function 

 Function IsStyleInRange(ByVal oStyle As Style, ByVal oRange As Range) As Boolean 
    With oRange.Find 
        .ClearFormatting 
        .Style = oStyle 
        .Forward = True 
        .Format = True 
        .Text = "" 
        .Execute 
    End With 
    If oRange.Find.Found = True Then 
        IsStyleInRange = True 
    Else 
        IsStyleInRange = False 
    End If 
End Function 
 
Sub StyleShowStyleInUse() 
    ActiveDocument.FormattingShowFont = False 
    ActiveDocument.FormattingShowParagraph = False 
    ActiveDocument.FormattingShowNumbering = False 
    ActiveDocument.FormattingShowNextLevel = False 
    ActiveDocument.FormattingShowFilter = wdShowFilterStylesInUse 
    ActiveDocument.StyleSortMethod = wdStyleSortByName 
End Sub

macropod · #2 08-01-2014, 02:28 AM

Since the only Styles you can delete from a document are user-defined Styles that aren't linked, I'm not sure that a macro that doesn't differentiate between these and unused built-in or linked user-defined Styles will be of much use.

The following macro takes a different approach, automatically deleting any unused unlinked user-defined Styles. Although this will save you the effort of manually deleting the un used Styles that can be deleted, it will still take some time to do all its processing.

Code:

Sub DeleteUnusedStyles()
Dim Doc As Document, bDel As Boolean
Dim Rng As Range, StlNm As String, i As Long
Application.ScreenUpdating = False
On Error Resume Next
Set Doc = ActiveDocument
With Doc
  For i = .Styles.Count To 1 Step -1
    With .Styles(i)
      If .BuiltIn = False And .Linked = 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

PS: When posting code, please use the code tags. They're on the 'Go Advanced' tab at the bottom of this screen.

freda0255 · #3 08-02-2014, 11:23 AM

Hello Paul,

Thank you very much for looking at this code. I appreciate your help very much.

I only wanted to hide the styles and not delete them in case some of the styles were part of a numbering scheme. Could this code be modified to exclude from deletion styles that are linked to numbering?

We use numbering linked to styles extensively. We usually link numbering to styles Heading 1 through Heading 9. However, if we need multiple numbering schemes in a document, we will use a program to create a new numbering scheme which creates 9 styles (e.g., Legal_L1, through Legal_L9) and link all 9 levels of numbering to those 9 style names.

Is there a way to delete unused custom styles but retain the style if it is linked to numbering?

macropod · #4 08-02-2014, 09:40 PM

As indicated in my previous post, with that macro you can't delete linked Styles or Styles that are in use, so it seems that, apart from deleting as opposed to merely hiding Styles, it does what you want. To merely hide the unused Styles instead of deleting them, regarless of whether they're built-in or linked, you could use:

Code:

Sub HideUnusedStyles()
Dim Doc As Document, bDel As Boolean
Dim Rng As Range, StlNm As String, i As Long
Application.ScreenUpdating = False
On Error Resume Next
Set Doc = ActiveDocument
With Doc
  For i = .Styles.Count To 1 Step -1
    With .Styles(i)
        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 .Visibility = False
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

The only material difference between this sub and the previous one is that I've omitted the 'If .BuiltIn = False And .Linked = False Then' test and I've changed:
.Delete
to:
.Visibility = False

freda0255 · #5 08-04-2014, 07:35 PM

Thank you once again Paul. I am going to study your code and work to adapt it to this particular problem. I am very grateful for your assistance.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
optimizing computer for MS Office	shmu	Misc	4	02-18-2014 12:34 AM
VBA Code for adding Macro to QAT	OTPM	Project	4	08-22-2013 01:33 PM
Need Macro code for Outlook	gbaker	Outlook	0	04-11-2013 10:29 AM
I need help with macro...code needed for automatic sorting	chefmate	Excel Programming	1	08-26-2012 01:04 AM
Macro to Table Style	ubns	Word VBA	1	04-16-2012 05:01 AM