Re: Looking for a better way

I could pick a few holes in your code (like Cancel doesn't work before you
have looped - also it doesn't highlight for me unless I add a screen refresh
to force it) - but I don't think you're missing anything simple!

I have tried both with the Find object and the Find Dialog object and I
cannot get anything in code to fire the F&R ending and message when it's
looped back to where it started from. You can get the builtin "do you want
to continue from the beginning" message but there doesn't appear to be any
way to tell that's it's been issued or to stop it being issued again when
the Find gets to the end again, without remembering and checking for
yourself.

FWIW, here's my best effort to date - and neither yours nor mine copes quite
properly when the initial IP is within an italicised string, but I got bored
......

Sub FindAndReplace()

Dim StartPoint As Range
Dim PrevFound As Range
Dim Looped As Boolean

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = "^&"
.Forward = True
.Wrap = wdFindAsk
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchByte = False
.CorrectHangulEndings = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

Selection.Find.Font.Italic = True
Selection.Find.Replacement.Font.Italic = False

Set StartPoint = Selection.Range.Duplicate

Do While Selection.Find.Execute

If Not Looped Then
If PrevFound Is Nothing Then
Looped = (Selection.Start < StartPoint.Start)
Else
Looped = (Selection.Start <= PrevFound.Start)
End If
End If

If Looped Then
If Selection.Start >= StartPoint.Start Then Exit Do
End If

Set PrevFound = Selection.Range.Duplicate

Select Case MsgBox("Change?", vbYesNoCancel)

Case vbYes
With Selection
.Collapse Direction:=wdCollapseStart
.Find.Execute Replace:=wdReplaceOne
.Collapse Direction:=wdCollapseEnd
End With

Case vbCancel
Exit Do

End Select

Loop

StartPoint.Select

Set StartPoint = Nothing
Set PrevFound = Nothing

MsgBox "All requested changes have been made"

End Sub

--
Enjoy,
Tony


"Greg" <gmaxey@xxxxxxxx> wrote in message
news:1133529215.205904.215370@xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
> Earlier I was helping a user that wanted a VBA find routine that would
> start at the IP and go to the end of the document. On reaching the
> end, the user wanted a pop-up to querry if the routine should loop to
> the begining of the document. I got that far without any trouble.
> However, I got tripped up trying to stop the routine at the IP after it
> began searching from the document start. I scrapped together something
> that appears workable, but it seems I am missing something simple.
> Review and comments welcomed.
>
> Sub ScratchMacro()
> Dim oRng As Range
> Dim oRng1 As Range
> Dim oRng2 As Range
> Dim i As Long
> Dim bLooped As Boolean
> Set oRng1 = ActiveDocument.Content
> Set oRng2 = ActiveDocument.Content
> i = Selection.Start
> oRng1.Start = i
> oRng2.End = i
> Set oRng = oRng1
> bLooped = False
> LoopTwo:
> With oRng.Find
> .ClearFormatting
> .Replacement.ClearFormatting
> .Text = ""
> .Font.Italic = True
> .Wrap = wdFindStop
> Do While .Execute
> If bLooped = True And oRng.Start > i Then
> MsgBox "Finished."
> Exit Sub
> End If
> oRng.HighlightColorIndex = wdYellow
> Select Case MsgBox("Do you want to remove italics from: " _
> & oRng.Text, vbYesNoCancel, "Action")
> Case Is = vbYes
> oRng.Font.Italic = False
> oRng.HighlightColorIndex = wdNoHighlight
> oRng.Collapse wdCollapseEnd
> Case Is = vbNo
> oRng.HighlightColorIndex = wdNoHighlight
> oRng.Collapse wdCollapseEnd
> Case Is = vbCancel
> oRng.HighlightColorIndex = wdNoHighlight
> Exit Do
> End Select
> Loop
> End With
> If bLooped = False Then
> If MsgBox("Do you want to loop to start?", _
> vbYesNo, "Loop to Start") = vbYes Then
> bLooped = True
> Set oRng = oRng2
> GoTo LoopTwo
> End If
> End If
> End Sub
>


.

Relevant Pages