Remove OR replace faulty paragraph marks using VBA macro

I have some faulty paragraphs, which are causing my other macros to not work properly.

1. They are usually heading style 2, style 3
2. Empty (not sure)
3. before OR after table (not sure)
4. surrounded by dotted line
5. causes the heading and next table to merged together (not sure)

I tried to replace/removed those with the following macro:

Sub HeadingParaBug()
    Dim H As Range
    Set H = ActiveDocument.Range
    LS = Application.International(wdListSeparator)
    
    With H.Find
        
        .Text = "^p "
        .Replacement.Text = "^p"
        .Execute Replace:=wdReplaceAll
        
        .Text = " ^p"
        .Replacement.Text = "^p"
        .Execute Replace:=wdReplaceAll
        
        .Text = "^p ^p"
        .Replacement.Text = "^p^p"
        .Execute Replace:=wdReplaceAll
        
        .Text = "^13{2" & LS & "}"
        .Replacement.Text = "^p"
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
        .Text = ""
        .Style = wdStyleHeading2
        .MatchWildcards = False
    Do While .Execute
    If H.Text <> vbCr Then
        H.Collapse 0
        H.Select
        H.InsertParagraph
        H.Delete
    End If
        H.Collapse 0
    Loop
    End With
    
    Set H = ActiveDocument.Range
    
    With H.Find
        .Style = wdStyleHeading3
    Do While .Execute
    If H.Text <> vbCr Then
        H.Collapse 0
        H.Select
        H.InsertParagraph
        H.Delete
    End If
        H.Collapse 0
    Loop
    
    End With
    
End Sub

But somehow, it do not completely removed/replace the faulty paragraph marks. The above macro finds those paragraphs, add new and then remove it. which eventually removed the dotted line.

Can anybody explain this phenomena? what is the right ways to remove/replace those paragraphs. please download and see test file with error on page 7

Update: Even I tried with the following code but it did nothing (on MacOS Video). I think it is not finding the hidden paragraphs:

Sub HidNempty()

    Dim H As Range
    Set H = ActiveDocument.Range
    
    With H.Find
        
        .Text = "^p "
        .Replacement.Text = "^p"
        .Execute Replace:=wdReplaceAll
        
        .Text = " ^p"
        .Replacement.Text = "^p"
        .Execute Replace:=wdReplaceAll
        
        .Text = "^p ^p"
        .Replacement.Text = "^p^p"
        .Execute Replace:=wdReplaceAll
        
        .Text = "^p"
    Do While .Execute
        
        If H.Font.Hidden = True Then
            H.Font.Hidden = False
            If Len(Trim(H.Paragraphs(1).Range.Text)) = 1 Then
                H.Delete
            
            End If
        End If
    Loop
    End With
    
End Sub