Replace and Search Operation (incl. a counter) just for selectedparagraphs

[andreas]

Dear Experts:

below code is supposed to replace redundant spaces with tabstops just
within the selected paragraphs. Regrettably all the redundant spaces
within the whole document get worked on.

How has the code to be changed to work only on the selection (the
selection for example could be only just one paragraph).

Help is much appreciated. Thank you very much in advance.

Regards, Andreas



Sub SearchAndReplaceJustinSelectedParagraphs()

Dim intcount As Long
Dim myRange As Range


intcount = 0
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

Set myRange = Selection.Range
myRange.Select

With myRange.Find
..Forward = True
.Wrap = wdFindContinue
.ClearFormatting
.Text = " {2;}"
.Replacement.Text = "^t"
.MatchWildcards = True
While .Execute(Replace:=wdReplaceOne)
myRange.Collapse wdCollapseEnd
intcount = intcount + 1
Wend
End With

MsgBox intcount
End Sub

 

[Doug Robbins - Word MVP]

Use:

Dim myRange As Range
Dim intcount As Long
intcount = 0
Set myRange = Selection.Range
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(FindText:=" {2,}", Forward:=True, _
MatchWildcards:=True, Wrap:=wdFindContinue) = True
If Selection.Range.Start > myRange.Start And Selection.Range.End <
myRange.End Then
Selection.Text = vbTab
intcount = intcount + 1
Else
GoTo Message
End If
Loop
End With
Message:
MsgBox intcount


--
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

 

[macropod]

Hi andreas,

Try:
Sub Andreas()
Dim i As Integer
With Selection
i = .Characters.Count
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = " {2,}"
.Replacement.Text = "^t"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
MsgBox i - .Characters.Count & " replacements made"
End With
End Sub

 

[Doug Robbins - Word MVP]

Hi Paul,

While that code does limit the changes to the selected text, the count of
the replacements made is a bit odd.

If there is one instance of two spaces, the count is 1
One instance of three spaces, the count is 2
and similar anomalies for other combinations of instances and spaces.

--
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

Hi andreas,

Try:
Sub Andreas()
Dim i As Integer
With Selection
i = .Characters.Count
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = " {2,}"
.Replacement.Text = "^t"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
MsgBox i - .Characters.Count & " replacements made"
End With
End Sub

--
Cheers
macropod
[Microsoft MVP - Word]

Dear Experts:

below code is supposed to replace redundant spaces with tabstops just
within the selected paragraphs. Regrettably all the redundant spaces
within the whole document get worked on.

How has the code to be changed to work only on the selection (the
selection for example could be only just one paragraph).

Help is much appreciated. Thank you very much in advance.

Regards, Andreas



Sub SearchAndReplaceJustinSelectedParagraphs()

Dim intcount As Long
Dim myRange As Range


intcount = 0
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

Set myRange = Selection.Range
myRange.Select

With myRange.Find
.Forward = True
.Wrap = wdFindContinue
.ClearFormatting
.Text = " {2;}"
.Replacement.Text = "^t"
.MatchWildcards = True
While .Execute(Replace:=wdReplaceOne)
myRange.Collapse wdCollapseEnd
intcount = intcount + 1
Wend
End With

MsgBox intcount
End Sub

 

[andreas]

Use:

Dim myRange As Range
Dim intcount As Long
intcount = 0
Set myRange = Selection.Range
Selection.Find.ClearFormatting
With Selection.Find
    Do While .Execute(FindText:=" {2,}", Forward:=True, _
        MatchWildcards:=True, Wrap:=wdFindContinue) = True
        If Selection.Range.Start > myRange.Start And Selection.Range.End <
myRange.End Then
            Selection.Text = vbTab
            intcount = intcount + 1
        Else
            GoTo Message
        End If
    Loop
End With
Message:
MsgBox intcount

--
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
















- Show quoted text -

Hi Doug,

great, Exactly what I wanted. And thank you very much for your
insights into replacing redundant spacing.

There is one thing I would like to ask you. I would like to preserve
the original selection for further operations in the same macro.

How is this achieved?

Help is much appreciated. Thank you very much in advance. Regards,
Andreas

 

[macropod]

Hi Doug,

On reflection, the count is the count of spaces replaced, not the number of tabs they've been replaced with.

--
Cheers
macropod
[Microsoft MVP - Word]

Hi Paul,

While that code does limit the changes to the selected text, the count of
the replacements made is a bit odd.

If there is one instance of two spaces, the count is 1
One instance of three spaces, the count is 2
and similar anomalies for other combinations of instances and spaces.

--
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

Hi andreas,

Try:
Sub Andreas()
Dim i As Integer
With Selection
i = .Characters.Count
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = " {2,}"
.Replacement.Text = "^t"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
MsgBox i - .Characters.Count & " replacements made"
End With
End Sub

--
Cheers
macropod
[Microsoft MVP - Word]

Dear Experts:

below code is supposed to replace redundant spaces with tabstops just
within the selected paragraphs. Regrettably all the redundant spaces
within the whole document get worked on.

How has the code to be changed to work only on the selection (the
selection for example could be only just one paragraph).

Help is much appreciated. Thank you very much in advance.

Regards, Andreas



Sub SearchAndReplaceJustinSelectedParagraphs()

Dim intcount As Long
Dim myRange As Range


intcount = 0
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

Set myRange = Selection.Range
myRange.Select

With myRange.Find
.Forward = True
.Wrap = wdFindContinue
.ClearFormatting
.Text = " {2;}"
.Replacement.Text = "^t"
.MatchWildcards = True
While .Execute(Replace:=wdReplaceOne)
myRange.Collapse wdCollapseEnd
intcount = intcount + 1
Wend
End With

MsgBox intcount
End Sub

 

[Pesach Shelnitz]

Hi Andreas,

In my opinion, the best way to preserve the original selection for further
operations is to do the following.
1. Define two variables of type Long:
Dim StartPos As Long
Dim EndPos As Long
2. Set them equal to the start and end of the range of the original selection:
StartPos = Selection.Range.Start
EndPos = Selection.Range.End
3. When you want to use the range of the original selection in a further
operation, set the start and end of a Range object equal to their values:
myRange.Start = StartPos
myRange.End = EndPos
4. Use myRange in the operation.

 

[andreas]

Hi Andreas,

In my opinion, the best way to preserve the original selection for further
operations  is to do the following.
1. Define two variables of type Long:
    Dim StartPos As Long
    Dim EndPos As Long
2. Set them equal to the start and end of the range of the original selection:
    StartPos = Selection.Range.Start
    EndPos = Selection.Range.End
3. When you want to use the range of the original selection in a further
operation, set the start and end of a Range object equal to their values:
    myRange.Start = StartPos
    myRange.End = EndPos
4. Use myRange in the operation.

--
Hope this helps,
Pesach Shelnitz
My Web site:http://makeofficework.com










- Show quoted text -

Hi Pesach,

thank you very much for your help. It works just fine.

I did my own trials and came up with a fairly simple solution (more or
less by chance, I must admit). Just added 'myRange.Select'. This works
for me.

Again thank you very much for your valuable help.

Regards, Andreas

Dim myRange As Range
Dim intcount1 As Long

intcount1 = 0
Set myRange = Selection.Range
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(FindText:=" {2;}", Forward:=True, _
MatchWildcards:=True, Wrap:=wdFindContinue) = True
If Selection.Range.Start > myRange.Start And
Selection.Range.End < myRange.End Then
Selection.Text = vbTab
intcount1 = intcount1 + 1

Else
myRange.Select (the original selection is preserved: code
snippet added by Andreas Hermle)
GoTo Message
End If
Loop
End With
Message: MsgBox intcount1

 

[andreas]

Hi andreas,

Try:
Sub Andreas()
Dim i As Integer
With Selection
  i = .Characters.Count
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = " {2,}"
    .Replacement.Text = "^t"
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
  End With
  MsgBox i - .Characters.Count & " replacements made"
End With
End Sub

--
Cheers
macropod
[Microsoft MVP - Word]

Dear Experts:

below code is supposed to replace redundant spaces with tabstops just
within the selected paragraphs. Regrettably all the redundant spaces
within the whole document get worked on.

How has the code to be changed to work only on the selection (the
selection for example could be only just one paragraph).

Help is much appreciated. Thank you very much in advance.

Regards, Andreas

Sub SearchAndReplaceJustinSelectedParagraphs()

Dim intcount As Long
Dim myRange As Range

intcount = 0
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

Set myRange = Selection.Range
myRange.Select

With myRange.Find
.Forward = True
  .Wrap = wdFindContinue
  .ClearFormatting
  .Text = " {2;}"
  .Replacement.Text = "^t"
  .MatchWildcards = True
  While .Execute(Replace:=wdReplaceOne)
  myRange.Collapse wdCollapseEnd
     intcount = intcount + 1
     Wend
End With

MsgBox intcount
End Sub- Hide quoted text -

- Show quoted text -

Hi Paul,

it is working fine. Thank you very much. As Doug said, this counting
has some restrictions. But I do not mind, I am glad to have an
alternative code for my problem.

Thank you very much for your professional help.

Regards, Andreas

 

[macropod]

Hi andreas,

If you don't need the tabs counter, you'll also find my code much faster with a large document.

--
Cheers
macropod
[Microsoft MVP - Word]

Hi andreas,

Try:
Sub Andreas()
Dim i As Integer
With Selection
i = .Characters.Count
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = " {2,}"
.Replacement.Text = "^t"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
MsgBox i - .Characters.Count & " replacements made"
End With
End Sub

--
Cheers
macropod
[Microsoft MVP - Word]

Dear Experts:

below code is supposed to replace redundant spaces with tabstops just
within the selected paragraphs. Regrettably all the redundant spaces
within the whole document get worked on.

How has the code to be changed to work only on the selection (the
selection for example could be only just one paragraph).

Help is much appreciated. Thank you very much in advance.

Regards, Andreas

Sub SearchAndReplaceJustinSelectedParagraphs()

Dim intcount As Long
Dim myRange As Range

intcount = 0
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

Set myRange = Selection.Range
myRange.Select

With myRange.Find
.Forward = True
.Wrap = wdFindContinue
.ClearFormatting
.Text = " {2;}"
.Replacement.Text = "^t"
.MatchWildcards = True
While .Execute(Replace:=wdReplaceOne)
myRange.Collapse wdCollapseEnd
intcount = intcount + 1
Wend
End With

MsgBox intcount
End Sub- Hide quoted text -

- Show quoted text -

Hi Paul,

it is working fine. Thank you very much. As Doug said, this counting
has some restrictions. But I do not mind, I am glad to have an
alternative code for my problem.

Thank you very much for your professional help.

Regards, Andreas