Delete an MS Word table row based on next row text using VBA

[Catarina]

Thank you in advance for your help on this.

I need to delete an MSWord table row based on the next row text.

My word table has headers which may or may not have sub-rows with details. I need to delete the header rows when there are no details below.

I can have, for example, this table, which is fine, no need to delete anything:

City
Lisbon
Porto
Madrid
London
Country
Portugal
Spain




But, if I have only this, then I need to delete the City header row (this is just an example, I have several header rows that need deleting when there are no contents below)

City
Country
Portugal
Spain

I tried adapting an earlier macro I had for deleting blank lines, but it is not working.

Dim oTable As Table, oRow As Range, oCell As Cell, Counter As Long, _
NumRows As Long, TextInRow As Boolean

' Specify which table you want to work on.
For Each oTable In ActiveDocument.Tables

' Set a range variable to the first row's range
Set oRow = oTable.Rows(1).Range
Set oNextRow = oTable.Rows(1).Range
NumRows = oTable.Rows.Count
Application.ScreenUpdating = False

For Counter = 1 To NumRows

    StatusBar = "Row " & Counter
    DeleteRow = False

    For Each oCell In oRow.Rows(1).Cells
                       
        If oCell.Range.Text = "City" & Chr(13) & Chr(7) And oRow.Rows(1).Next.Cells(1).Range.Text = "Country" & Chr(13) & Chr(7) Then
            DeleteRow = True
            Exit For
        End If
    
    Next oCell

    If DeleteRow Then
        oRow.Rows(1).Delete
    Else
        Set oRow = oRow.Next(wdRow)
    End If

Next Counter

Next oTable
Application.ScreenUpdating = True

All help will be much appreciated

[gmayor]

If you are going to delete rows in a loop then you need to reverse the loop or the count goes haywire i.e.

For Counter = NumRows to 1 Step -1

However there is an assortment of other issues in your code. Try the following instead.

Sub Macro1()
Dim oTable As Table
Dim oRng As Range, oRng2 As Range
    For Each oTable In ActiveDocument.Tables
        Application.ScreenUpdating = False
        Set oRng = oTable.Range
        With oRng.Find
            .Text = "City"
            Do While .Execute
                If oRng.InRange(oTable.Range) Then
                    If Not oRng.Rows(1).Range.Start = oTable.Rows(1).Range.Start Then
                        Set oRng2 = oRng.Rows(1).Previous.Range.Rows(1).Cells(1).Range
                        If InStr(1, oRng2, "Country") > 0 Then oRng.Rows(1).Delete
                    End If
                End If
            Loop
        End With
        Set oRng = oTable.Range
        With oRng.Find
            .Text = "Country"
            Do While .Execute
                If oRng.InRange(oTable.Range) Then
                    If Not oRng.Rows(1).Range.Start = oTable.Rows(1).Range.Start Then
                        Set oRng2 = oRng.Rows(1).Previous.Range.Rows(1).Cells(1).Range
                        If InStr(1, oRng2, "City") > 0 Or InStr(1, oRng2, "Country") > 0 Then oRng2.Rows(1).Delete
                    End If
                End If
            Loop
        End With
    Next oTable
    Application.ScreenUpdating = True
    Set oTable = Nothing
    Set oRng = Nothing
    Set oRng2 = Nothing
End Sub

[Catarina]

Hi gmayor,

You are a life saveer, thanks a million, it worked

Happy New Year and many thanks again
Regards
Catarina