Sub LineCount() Dim i As Integer, LineCount As Integer, Range1 As Long, Range2 As Range, l As String On Error Resume Next Application.ScreenUpdating = False With CommandBars(Word Count) .Visible = True .Controls(2).Execute l = .Controls(1).List(6) .Visible = False End With LineCount = Int(Mid(l, 1, Len(l) - 1)) With Selection .GoTo what:=wdGoToLine, which:=wdGoToLast For i = LineCount To 1 Step -1 .EndKey unit:=wdLine, Extend:=wdExtend If .Text Like +* = True Then .Range.Delete: .HomeKey unit:=wdLine, Extend:=wdExtend .GoTo what:=wdGoToLine, which:=wdGoToPrevious Next End With Application.ScreenUpdating = True End Sub