Delete last list Item with Word VBA

Question

I am trying to remove the last bullet/item from a bulleted list in Word with VBA.

It is possible to get the empty items with the following code, but I don't know how to delete this items:

For Each List In ActiveDocument.ListParagraphs
    If Len(List.Range.Text = 2) Then
    'Delete this list Item
    End If
Next

This is an example of the list:

Item 1
Item 2
Item 3

I already tried to select the Item via Range.Text.Select, but that did not work.

Any suggestions are welcome, thank you in advance.

Edit:

The problem is to delete the entire list item, including the list bullet. list.Range.Delete does not work and it looks like that the macro is even crashing.

The message box appears only a single time, even if there are multiple occurrences in the Document, if I remove list.Range.Delete the box appears a single time for every empty item.

Dim list As Paragraph

For Each list In ActiveDocument.ListParagraphs
    MsgBox Len(list.Range.Text)
    If Len(list.Range.Text) = 2 Then
        MsgBox "DELETE"
        list.Range.Delete
    End If
Next

GSerg GSerg · Accepted Answer · 2011-12-19T16:41:55

~~List.Range.Text = 2 is not going to be true for empty list paragraphs. It's 1.~~

Dim list As Paragraph

For Each list In ActiveDocument.ListParagraphs
  If Len(Trim$(list.Range.Text)) = 1 Then
      list.Range.Delete
  End If
Next

EDIT: ActiveDocument, Trim$ as suggested in the comments.

The problem is that last paragraph in a table's cell has an end-of-cell marker as its last characters, and that may not be deleted.

The generic solution is to always remove the last character from a paragraph before examining it for length. Because paragraphs that ought to be deleted have zero length, we can delete them "to the left" (as if backspace was pressed), which preserves the end-of-cell marker and also works for paragraphs not in a table. This wouldn't work, however, if deleted paragraph wasn't empty:

Dim p As Paragraph

For Each p In ActiveDocument.ListParagraphs
  Dim range_to_examine As Range
  Set range_to_examine = p.Range

  If range_to_examine.End = range_to_examine.Start + 1 Then
    range_to_examine.Collapse wdCollapseStart
    range_to_examine.Delete wdCharacter, -1
  End If
Next

Delete last list Item with Word VBA

1 Answers