Deleting redundant lines   

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

date: Thu, 5 Jun 2008 14:26:49 -0700 (PDT)   author:   Spotty Boy

Re: Deleting redundant lines   

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

"Spotty Boy"  wrote in message 
news:a4a38d63-10ce-4058-8c0f-d63b86934769@f63g2000hsf.googlegroups.com...
> 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

date: Fri, 6 Jun 2008 16:33:53 +1000   author:   Doug Robbins - Word MVP