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!

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

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