Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, StrTxt As String, Tbl As Table
For Each Tbl In ActiveDocument.Tables
  With Tbl
    For i = .Range.Cells(.Range.Cells.Count).RowIndex To 2 Step -1
      ' Counts the rows by 1 down
      On Error Resume Next
      If .Rows(i - 1).Cells.Count > 1 Then
        ' Rows will count by one cell
        If InStr(.Cell(i, 2).Range.Text, "Ensure S") = 1 Then
          ' if the second column starts with "Ensure S" you know what I mean the first part of the procedure in the step then
          StrTxt = Split(.Cell(i, 2).Range.Text, " ")(1)
          ' Until the End or until the space is found after "Ensure S"
          .Rows.Add BeforeRow:=.Rows(i)
          ' Add an extra row for the Grey Bar
          With .Rows(i)
            .Cells.Merge
            'Merge those Cells!
            .Shading.BackgroundPatternColor = -603930625
            'Grey those cells!
            .Range.Style = wdStyleNormal
            'wdStyleNormal is the normal font template, for me which is Times new roman 12 for others it could be arial or calabri based on the template
            .Range.ParagraphFormat.KeepWithNext = wdToggle
            'Keep with next
            .Range.Text = "Step " & StrTxt
            'add "Step" Text infront of the step number
            .Range.Rows.Height = 18
            'Height is configurable
            .Range.Bold = wdToggle
            'Bold the Grey Bar text
            .Range.Font.Size = 10
            'Now shrink the text
          End With
        End If
      Else
        i = i - 1
        ' Makes the program not crash <- Suprisingly the hardest part lol
      End If
    Next
  End With
Next
Application.ScreenUpdating = True
End Sub