Help with Selection VBA

[JamesWood]

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]

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]

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]

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]

Here is one way:

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]

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

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]

Originally Posted by gmaxey

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

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!