Macro to reformat text not working - help

[Restricted]

Not sure when Graham will be back. This is not the cleanest solution, but I didn't have much time:

Sub ScratchMacro()
'A basic Word Macro coded by Gregory K. Maxey
Dim oTbl As Table
Dim lngRow As Long
Dim oRng As Range
  Set oTbl = Selection.Tables(1)
  For lngRow = 2 To oTbl.Rows.Count
    Set oRng = oTbl.Rows(lngRow).Cells(3).Range
    With oRng.Find
      .Text = "Domain"
      If .Execute Then
        oRng.InsertAfter ": "
        oRng.Collapse wdCollapseEnd
        oRng.Move wdCharacter, 1
        oRng.InsertAfter " "
        oRng.Collapse wdCollapseEnd
        oRng.InsertSymbol Font:="Times New Roman", CharacterNumber:=8211, Unicode:=True
        oRng.Collapse wdCollapseEnd
        oRng.Move wdCharacter, 1
        oRng.InsertAfter " "
        oRng.Paragraphs(1).SpaceAfter = 12
      End If
    End With
    Set oRng = oTbl.Rows(lngRow).Cells(3).Range
    With oRng.Find
      .Text = "Sub-domain"
      If .Execute Then
        oRng.InsertAfter ": "
        oRng.Collapse wdCollapseEnd
        oRng.Move wdCharacter, 3
        oRng.InsertAfter " "
        oRng.Collapse wdCollapseEnd
        oRng.InsertSymbol Font:="Times New Roman", CharacterNumber:=8211, Unicode:=True
        oRng.Collapse wdCollapseEnd
        oRng.Move wdCharacter, 1
        oRng.InsertAfter " "
        oRng.Paragraphs(1).SpaceAfter = 12
      End If
    End With
    Set oRng = oTbl.Rows(lngRow).Cells(3).Range
    With oRng.Find
      .Text = "Task Statement"
      If .Execute Then
        oRng.InsertAfter ": "
        oRng.Collapse wdCollapseEnd
        oRng.Move wdCharacter, 1
        oRng.InsertAfter " "
        oRng.Collapse wdCollapseEnd
        oRng.InsertSymbol Font:="Times New Roman", CharacterNumber:=8211, Unicode:=True
        oRng.Collapse wdCollapseEnd
        oRng.Move wdCharacter, 1
        oRng.InsertAfter " "
      End If
    End With
  Next
lbl_Exit:
  Exit Sub
End Sub

Hi Greg how do we update the code so that it accommodates for where the 'Task Statement' is followed by more than 1 digit? e.g. 2 digits?

e.g. Task Statement5Bananas and muscle health, correctly turns into: Task Statement: 5 – Bananas and muscle health
However when there are 2 digits involved (e.g. '45' instead of '5'):
Task Statement45Bananas and muscle health, turns into: Task Statement: 4 – 5Bananas and muscle health
whereas it should be: Task Statement: 45 – Bananas and muscle health


I have tried to do it via ReGex by modifying your code, but the code isn't functioning properly - although it works to accommodate the 2 digits, it is instead replacing everything with only the "Task Statement" modifications, and not the "Domain" and "Sub-domain" modifications:

Sub ScratchMacro()
'A basic Word Macro coded by Gregory K. Maxey
Dim oTbl As Table
Dim lngRow As Long
Dim oRng As Range
Dim regEx As Object
Dim match As Object
    
' Create a regular expression object
Set regEx = CreateObject("VBScript.RegExp")
regEx.Global = True
regEx.IgnoreCase = True
regEx.Pattern = "Task Statement(\d+)([^0-9]+)"
    
  Set oTbl = Selection.Tables(1)
  For lngRow = 2 To oTbl.Rows.Count
    Set oRng = oTbl.Rows(lngRow).Cells(3).Range
    With oRng.Find
      .Text = "Domain"
      If .Execute Then
        oRng.InsertAfter ": "
        oRng.Collapse wdCollapseEnd
        oRng.Move wdCharacter, 1
        oRng.InsertAfter " "
        oRng.Collapse wdCollapseEnd
        oRng.InsertSymbol Font:="Times New Roman", CharacterNumber:=8211, Unicode:=True
        oRng.Collapse wdCollapseEnd
        oRng.Move wdCharacter, 1
        oRng.InsertAfter " "
        oRng.Paragraphs(1).SpaceAfter = 12
      End If
    End With
    Set oRng = oTbl.Rows(lngRow).Cells(3).Range
    With oRng.Find
      .Text = "Sub-domain"
      If .Execute Then
        oRng.InsertAfter ": "
        oRng.Collapse wdCollapseEnd
        oRng.Move wdCharacter, 3
        oRng.InsertAfter " "
        oRng.Collapse wdCollapseEnd
        oRng.InsertSymbol Font:="Times New Roman", CharacterNumber:=8211, Unicode:=True
        oRng.Collapse wdCollapseEnd
        oRng.Move wdCharacter, 1
        oRng.InsertAfter " "
        oRng.Paragraphs(1).SpaceAfter = 12
      End If
    End With
    Set oRng = oTbl.Rows(lngRow).Cells(3).Range
    With oRng.Find
      .Text = "Task Statement"
        If regEx.Test(oRng.Text) Then
            Set match = regEx.Execute(oRng.Text)(0)
            oRng.Text = "Task Statement: " & match.SubMatches(0) & " – " & match.SubMatches(1)
            oRng.Paragraphs(1).SpaceAfter = 12
        End If
    End With
  Next
lbl_Exit:
  Exit Sub
End Sub

However this was just my thinking/approach (which didn't work well) - if you have any other ways to achieve it?