Help with Selection VBA

JamesWood · #1 11-16-2020, 08:10 AM

Hi guys

I'm writing a code for the typists at our company to use. This one in particular just searches for double spaces and asks to convert them to a single space. It cycles through each instance it finds, asking if you want to change it to a single space.

The first instance shows the selection it found, but when it cycles to the next instance it finds it is not showing as selected -- although it still corrects the double space, it just doesn't select the area; I want it to show the selection, so users know what they're correcting. Thoughts?

Sub StyleCheck_DoubleSpaces_Test()

Selection.HomeKey Unit:=wdStory
Dim oFound As Boolean
oRange = Selection.Text
oSearch = Selection.Find.Found
With Selection.Find
oFound = .Execute

While oFound
With oRange
With oSearch

Dim Result As Integer
Result = MsgBox("Amend selection to single space?", vbQuestion + vbOKCancel)
If Result = vbCancel Then Exit Sub

With ActiveDocument.Content.Find
oFound = .Execute(FindText:=" ", Forward:=True, Wrap:=wdFindStop, ReplaceWith:=" ", Replace:=wdReplaceOne)
End With

End With
End With
Wend

End With
End Sub

gmaxey · #2 11-16-2020, 09:07 AM

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = " "
.Wrap = wdFindStop
While .Execute
oRng.Select
If MsgBox("Do you want to convert selected text to a single space.", vbYesNo, "Conver") = vbYes Then
oRng.Text = " "
oRng.Collapse wdCollapseEnd
End If
Wend
End With
lbl_Exit:
Exit Sub
End Sub

JamesWood · #3 11-17-2020, 01:56 AM

Quote:

Originally Posted by gmaxey

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = " "
.Wrap = wdFindStop
While .Execute
oRng.Select
If MsgBox("Do you want to convert selected text to a single space.", vbYesNo, "Conver") = vbYes Then
oRng.Text = " "
oRng.Collapse wdCollapseEnd
End If
Wend
End With
lbl_Exit:
Exit Sub
End Sub

Holy crap. Greg you're a genius, thank you so much for your help!!

JamesWood · #4 11-17-2020, 05:17 AM

Hi Greg

Leading on from this, I am making another version that searches for contractions. However, how can I make it search without matchcase, but replace WITH matchcase? e.g. if it finds "Can't" I want it to replace it with Cannot, not cannot.

Sub StyleCheck_ContractionsTest()
Dim oRng As Range
Set oRng = ActiveDocument.Range
Selection.HomeKey Unit:=wdStory
With oRng.Find
.Text = "can't"
.MatchCase = False
.Wrap = wdFindStop
While .Execute
oRng.Select
If MsgBox("Do you want to amend the selected contraction?", vbYesNo, "Conver") = vbYes Then
oRng.Text = "cannot"
oRng.Collapse wdCollapseEnd
End If
Wend
End With
MsgBox ("Complete!")
lbl_Exit:
Exit Sub
End Sub

gmaxey · #5 11-17-2020, 05:59 AM

Here is one way:

Code:

Sub StyleCheck_ContractionsTest()
Dim oRng As Range
  Set oRng = ActiveDocument.Range
  Selection.HomeKey Unit:=wdStory
  With oRng.Find
    .Text = "can't"
    .MatchCase = False
    .Wrap = wdFindStop
     While .Execute
       oRng.Select
       If MsgBox("Do you want to amend the selected contraction?", vbYesNo, "Conver") = vbYes Then
         If oRng.Characters.First = "C" Then
           oRng.Text = "Cannot"
         Else
           oRng.Text = "cannot"
         End If
         oRng.Collapse wdCollapseEnd
       End If
     Wend
  End With
  MsgBox ("Complete!")
lbl_Exit:
  Exit Sub
End Sub

gmaxey · #6 11-17-2020, 06:21 AM

Just tinkering and perhaps with some searching you may find something more complete but:

Code:

Sub StyleCheck_ContractionsTest()
Dim oRng As Range
Dim oRngEval As Range
  Set oRng = ActiveDocument.Range
  Selection.HomeKey Unit:=wdStory
  With oRng.Find
    .Text = "n't"
    .Wrap = wdFindStop
     While .Execute
       Set oRngEval = oRng.Words(1).Duplicate
       If oRngEval.Characters.Last = " " Then oRngEval.End = oRngEval.End - 1
       oRngEval.Select
       If MsgBox("Do you want to amend the selected contraction?", vbYesNo, "Convert") = vbYes Then
         MsgBox Left(oRngEval.Text, Len(oRngEval.Text) - 2)
         Select Case Left(oRngEval.Text, Len(oRngEval.Text) - 2)
           Case Is = "can": oRngEval.Text = "cannot"
           Case Is = "Can": oRngEval.Text = "Cannot"
           Case Is = "couldn": oRngEval.Text = "could not"
           Case Is = "Couldn": oRngEval.Text = "Could not"
           Case Is = "shouldn": oRngEval.Text = "should not"
           Case Is = "Shouldn": oRngEval.Text = "Should not"
           Case Is = "wouldn": oRngEval.Text = "would not"
           Case Is = "Wouldn": oRngEval.Text = "would not"
           Case Is = "won": oRngEval.Text = "will not"
           Case Is = "Won": oRngEval.Text = "will not"
           Case Is = "didn": oRngEval.Text = "did not"
           Case Is = "Didn": oRngEval.Text = "Did not"
           Case Is = "don": oRngEval.Text = "do not"
           Case Is = "Don": oRngEval.Text = "Do not"
         End Select
         oRng.Collapse wdCollapseEnd
       End If
     Wend
  End With
  MsgBox ("Complete!")
lbl_Exit:
  Exit Sub
End Sub

JamesWood · #7 11-17-2020, 06:46 AM

Quote:

Originally Posted by gmaxey

Just tinkering and perhaps with some searching you may find something more complete but:

Code:

Sub StyleCheck_ContractionsTest()
Dim oRng As Range
Dim oRngEval As Range
  Set oRng = ActiveDocument.Range
  Selection.HomeKey Unit:=wdStory
  With oRng.Find
    .Text = "n't"
    .Wrap = wdFindStop
     While .Execute
       Set oRngEval = oRng.Words(1).Duplicate
       If oRngEval.Characters.Last = " " Then oRngEval.End = oRngEval.End - 1
       oRngEval.Select
       If MsgBox("Do you want to amend the selected contraction?", vbYesNo, "Convert") = vbYes Then
         MsgBox Left(oRngEval.Text, Len(oRngEval.Text) - 2)
         Select Case Left(oRngEval.Text, Len(oRngEval.Text) - 2)
           Case Is = "can": oRngEval.Text = "cannot"
           Case Is = "Can": oRngEval.Text = "Cannot"
           Case Is = "couldn": oRngEval.Text = "could not"
           Case Is = "Couldn": oRngEval.Text = "Could not"
           Case Is = "shouldn": oRngEval.Text = "should not"
           Case Is = "Shouldn": oRngEval.Text = "Should not"
           Case Is = "wouldn": oRngEval.Text = "would not"
           Case Is = "Wouldn": oRngEval.Text = "would not"
           Case Is = "won": oRngEval.Text = "will not"
           Case Is = "Won": oRngEval.Text = "will not"
           Case Is = "didn": oRngEval.Text = "did not"
           Case Is = "Didn": oRngEval.Text = "Did not"
           Case Is = "don": oRngEval.Text = "do not"
           Case Is = "Don": oRngEval.Text = "Do not"
         End Select
         oRng.Collapse wdCollapseEnd
       End If
     Wend
  End With
  MsgBox ("Complete!")
lbl_Exit:
  Exit Sub
End Sub

That's incredible, absolutely what I was looking for. Thank you so much Greg!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Is there a way to go to the next selection?	wardw	Word	2	09-25-2019 09:19 AM
This is not a valid selection	edenworkshops	Word	3	09-18-2019 05:43 AM
Selection.Bookmarks("\headinglevel") WITHOUT Selection	NobodysPerfect	Word VBA	3	01-14-2015 12:58 PM
Selection of all Text for a specific page in word is spanning selection across pages	ramsgarla	Word VBA	9	12-05-2012 03:23 AM
How do you add to a selection list?	bryanarn	Excel	2	03-05-2012 05:04 PM