Regex + Word Macro for Replacing Styles

Question

I've got a bunch of documents with disparate styles that I've been adding to a long Macro that finds and replaces these styles with the correct ones. Right now, I'm just adding to a list as I find a wrong style. For example, there can be Heading 1, heading 1, H1, or h1. I want to write a find and replace function for each of those for the moment. What would be cooler is if I could write a catch all macro for these sorts of things using Regex: (h|H).{6}\\s1 (not the best Regex writer, so bear with that). Ideally that would catch anything the variations of heading 1 (though it would not catch the h1, H1 cases, though I could add that easily enough.

I know that VBA supports Regex. I've added the reference to it. I also know how this would work for replacing specific text. I'm not replacing text though. ONLY formatting. I haven't played around with it too much. I just want to know if I can use the Regex when working specifically with a style. Here's what the functions look like right now:

Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Heading 1")
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles("SSC TOC 2")
With Selection.Find
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

I simply recorded that. Now, would I be able to put Regex in place of that string, like so:

Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles(someRegex function (h|H).{6}\s1)
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles("SSC TOC 2")
With Selection.Find
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

Basically just using a function someRegex function (h|H).{6}\\s1 in place of the string literal. Is there any way to do this? Would appreciate any guidance or help!

Answer 1

You could use something along the lines the following macro to delete all unused user-defined Styles (except Linked Styles) in a document, and to clean up the various H1, etc. Styles you mentioned:

Sub CleanUpStyles()
Application.ScreenUpdating = False
Dim Doc As Document, bDel As Boolean, bHid As Boolean
Dim Rng As Range, StlNm As String, i As Long
bHid = ActiveWindow.View.ShowHiddenText
ActiveWindow.View.ShowHiddenText = True
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
              If StlNm Like "[Hh]*#" Then
                If StlNm <> "Heading " & Right(StlNm, 1) Then
                  .Style = "Heading " & Right(StlNm, 1)
                  bDel = True
                End If
              Else
                bDel = False
              End If
              Exit For
            End If
          End With
        Next
        If bDel = True Then .Delete
      End If
    End With
  Next
End With
ActiveWindow.View.ShowHiddenText = bHid
Application.ScreenUpdating = True
End Sub