Deleting redundant lines

[Spotty Boy]

Hi,
Have the following kind of automated listings. Need to eliminate the
duplicate time entries. Can't figure out how to compare current time
to the previous time. See my preliminary macro at the end. There can
be weeks of this. The macro gets no errors. Please no laughing out
loud or snorting. However, snickering is OK ...

What Is:
--------------
BREAKFAST
07:00
Place orders
07:00
Handout activity lists
07:00
Assign jobs

LUNCH
12:00
Place orders
12:00
Discuss progress
12:00
Record problems


What I Need:
--------------
BREAKFAST
07:00
Place orders
Handout activity lists
Assign jobs

LUNCH
12:00
Place orders
Discuss progress
Record problems

Macro
--------------
Sub deldupes()
'
' Delete duplicate time entries
'
'Dim prevText As String
'
Selection.Find.MatchWildcards = True
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
'
With Selection.Find
.Text = "([0-9])([0-9]))([0-9])([0-9])"
.Replacement.Text = "\1\2\3\4\5"
.Forward = True
.Wrap = wdFindContinue
End With
'
If Selection.Text = prevText Then
Selection.Find.Replacement.Text = ""
End If
'
prevText = Selection.Text
'
Selection.Find.Execute Replace:=wdReplaceAll
'
End Sub

 

[Doug Robbins - Word MVP]

Use:

Dim myrange As Range
Dim Flag As Boolean
Flag = False
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(Findtext:="[0-9]{2}:[0-9]{2}", Forward:=True,
_
MatchWildcards:=True, Wrap:=wdFindStop) = True
If Flag = False Then
Set myrange = Selection.Range
Selection.Collapse wdCollapseEnd
Flag = True
ElseIf Selection.Text = myrange.Text Then
Selection.Paragraphs(1).Range.Delete
Else
Set myrange = Selection.Range
Selection.Collapse wdCollapseEnd
Flag = True
End If
Loop
End With


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP