Fixing double-spaces to single spaces in Word 2003

[Alan Stancliff]

Greetings,

I am running Word 2003 and transcribing medical dictation

I have a macro put together some time ago with the kind help of some of
the members of this forum. Its purpose is to replace all instances of 2
or more consecutive spaces with 1 space and to replace all instances of
a paragraph marker preceded with a space to just a paragraph marker. A
hot key activates the macro, and it is supposed to run without moving
the insertion point or causing the page or viewpoint to jump.

Sometimes this macro works just like that. But at other times, running
the macro results in it finishing with the entire document highlighted,
and only an arrow key will unselect the material, causing the insertion
point to locate either at the very top or very bottom of the document,
depending on which arrow key I press.

Can anyone give me an idea what to do? The macro is attached below.

Regards,

Alan Stancliff

**************
Sub SingleSpace()
Dim oRg As Range
Set oRg = ActiveDocument.Range
With oRg.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = " "
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
With oRg.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = " ^p"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
Application.Run MacroName:="FixFindBox"
End Sub

 

[Doug Robbins - Word MVP]

Try the following:

Sub SingleSpace()
Dim oRg As Range, Here as Range
Set Here = Selection.Range
Set oRg = ActiveDocument.Range
With oRg.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = " "
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
With oRg.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = " ^p"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
Application.Run MacroName:="FixFindBox"
Here.Select
End Sub

--
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, originally posted via msnews.microsoft.com

 

[Alan Stancliff]

Hi Doug,

Thanks for the feedback.

I ran this macro, and once again, at unpredictable intervals, I ended up
with the entire report selected and the only way to unselect was to hit
an arrow key.

I have a few ideas that I'll play with today, and I'll post again soon
with a progress update.

Regards,

Alan Stancliff

 

[Helmut Weber]

Hi Alan,

how about that one:

Sub Test6()
Dim rDcm As Range
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Text = "[ ]{1,}"
.Replacement.Text = " "
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
again:
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Text = "[ ]^13"
.MatchWildcards = True
While .Execute
rDcm.Characters.First = ""
GoTo again
Wend
End With
End Sub
--

Greetings from Bavaria, Germany

Helmut Weber

Vista Small Business, Office XP