Finding Used Styles

List all styles in a document

Public Sub ListAllStyles() 

Dim objstyle As Word.Style 

   For Each objstyle In ActiveDocument.Styles 
     
     'Call MsgBox(objstyle.NameLocal)
      Selection.TypeText Text:=objstyle.NameLocal 
      Selection.TypeParagraph 
   
   Next objstyle 

End Sub 

Creates a new document with Heading XX style paragraphs from the active document

Public Sub UsedStyles 
Dim arAllStyles() As String 
Dim arUsedStyles() As String 
Dim lTotalParagraphs As Long 
Dim objParagraph As Paragraph 
Dim sPreviousStyle As String 
Dim iarraycount As Integer 
Dim icount As Integer 
Dim itotalusedstyles As Integer 

lTotalParagraphs = ActiveDocument.Paragraphs.Count 
ReDim arAllStyles(lTotalParagraphs) 

For Each objParagraph In ActiveDocument.Paragraphs 
   arAllStyles(iarraycount) = objParagraph.Style.Name 
   iarraycount := iarraycount + 1 
Next objParagraph 

'sort the array alphabetically

ReDim arUsedStyles(lTotalParagraphs) 

sPreviousStyle = "" 
For icount = 1 to lTotalParagraphs 
   If (arAllStyles(icount) <> sPreviousStyle) 
      itotalusedstyles = itotalusedstyles + 1 
      If (UBound(arUsedStyles) > itotalusedstyles) Then 
         ReDim Preserve arUsedStyles(itotalusedstyles) 
      End If 

      arUsedStyles(itotalusedstyles) = arAllStyles(itotalusedstyles) 
      sPreviousStyle = arAllStyles(itotalusedstyles) 
   End If 
Next icount 

Document.Add 
For icount = 1 To UBound(arStyles) 
   Selection.InsertAfter arAllStyles(icount) & vbCr 
   Selection.Collapse wdCollapseDirection.wdCollapseEnd 
Next icount 
End Sub