Re: Deleting redundant lines

Tech-Archive recommends: Fix windows errors by optimizing your registry

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" <don.roach@xxxxxxxxxxxxx> wrote in message
news:a4a38d63-10ce-4058-8c0f-d63b86934769@xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
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


.

Relevant Pages

  • Re: Macro to toggle Colors??
    ... Dim Flag As Boolean ... Dim aShape As Shape ... Selection.Find.Font.Color = wdColorWhite ...
    (microsoft.public.word.vba.general)
  • Re: Macro to toggle Colors??
    ... Dim Flag As Boolean ... Dim sTrans As String ... Selection.Find.Font.Color = wdColorWhite ...
    (microsoft.public.word.vba.general)
  • Re: query after insert fails
    ... code so that you use DAO methods to run the insert query so that you don't ... Values are passed to it by the calling sub. ... Dim db As DAO.Database ... Flag = Flag + 1 ...
    (microsoft.public.access.modulesdaovba)
  • Re: Type mismatch?
    ... Dim Flag As Boolean ... Dim Rng As Range ... Set Rng = Union) ...
    (microsoft.public.excel.programming)
  • Re: query after insert fails
    ... MyTableUpdate sub that does the oRS insert: ... such as you do in the first sub in your posted code. ... Dim db As DAO.Database ... Flag = Flag + 1 ...
    (microsoft.public.access.modulesdaovba)