Sub RemoveAppendices()
Dim i As Integer
Application.ScreenUpdating = False
Selection.HomeKey Unit:=wdStory
'Cntr = 3
'For i = 1 To 3
For i=3 to 1 step -1
    With Selection.Find
        .ClearFormatting
        .Text = "APPENDIX" & Cntr
        If Selection.Find.Execute Then
            Selection.Select
            Selection.Delete
            With Selection
                .EndKey Unit:=wdStory
                .TypeBackspace
                .Delete
            End With
        End If
    End With
    'Cntr = Cntr - 1

Next i
End Sub

Sub RemoveAppendices()
Dim i As Integer
For i = 3 To 1 Step -1
    'Selection.HomeKey Unit:=wdStory 'this would also work but I like wrap better
    With Selection.Find
        .Wrap = wdFindContinue
        .Text = "APPENDIX" & i
        .MatchWholeWord = True
        .MatchCase = True
        If Selection.Find.Execute Then
            Selection.Select
            Selection.Delete
            With Selection
                .EndKey Unit:=wdStory
                .TypeBackspace
                .Delete
            End With
        End If
    End With
Next i
End Sub