I'm trying to check for inconsistencies in spelling between UK and US English, "aging"/"ageing" as an example, to display a message box if inconsistencies are found.
I need to only search for text in the main body of work, i.e., between the words Abstract and References (both in bold, so it only catches when used as headers).
Wrap = wdFindContinue seems to be extending the search outside of the range.
Wrap = wdFindStop doesn't work.
wdFindAsk is inappropriate for the use case.
Sub inconsistencyCheck()
Dim myrange As Range
Dim a As Integer
Dim b As Integer
Set myrange = ActiveDocument.Range
a = 0
b = 0
'search for abstract
With Selection.Find
.Font.Bold = True
.Text = "Abstract"
.Wrap = wdFindContinue
.Execute
End With
myrange.Start = Selection.Start
'search for references
With Selection.Find
.Font.Bold = True
.Text = "References"
.Wrap = wdFindContinue
.Execute
End With
myrange.End = Selection.Start
myrange.Select
'search for inconsistencies
With myrange.Find
.MatchWholeWord = False
.Wrap = wdFindContinue
.Execute findtext:="aging"
.Format = True
.Forward = True
If .Found = True Then
a = 1
End If
.MatchWholeWord = False
.Wrap = wdFindContinue
.Execute findtext:="ageing"
.Format = True
.Forward = True
If .Found = True Then
b = 1
End If
End With
If a = 1 And b = 1 Then
MsgBox "Both spellings of ageing found, please revise"
End If
End Sub
Explanatory comments in code below
Sub inconsistencyCheck()
Dim myrange As Range
Dim a As Integer
Dim b As Integer
Set myrange = ActiveDocument.Range
a = 0
b = 0
'search for abstract
With Selection.Find
.Font.Bold = True
.Text = "Abstract"
.Wrap = wdFindContinue
.Execute
End With
myrange.Start = Selection.Start
'search for references
With Selection.Find
.Font.Bold = True
.Text = "References"
.Wrap = wdFindContinue
.Execute
End With
myrange.End = Selection.Start
'myrange.Select
'search for inconsistencies
With myrange.Find
.MatchWholeWord = False
.Wrap = wdFindStop
.Forward = True 'needs to be set before execution
'myrange will be redefined to the found match if successful so subsequent find won't succeed
'use a duplicate of myrange for the first execution.
'Duplicate needs to be used first or you'll simply duplicate the found range
If myrange.Duplicate.Find.Execute(findtext:="aging") Then a = 1
If .Execute(findtext:="ageing") Then b = 1
'.Format = True - not required you're trying to find text not formatting
'not required as .Execute returns a boolean
'If .Found = True Then
' a = 1
'End If
'find parameters are already set so don't need to set them again
' .MatchWholeWord = False
' .Wrap = wdFindContinue
' .Execute findtext:="ageing"
' .Format = True
' .Forward = True
' If .Found = True Then
' b = 1
' End If
End With
If a = 1 And b = 1 Then
MsgBox "Both spellings of ageing found, please revise"
End If
End Sub
Rewritten as I would do it:
Sub inconsistencyCheck()
Dim myrange As Range, findIn As Range
Dim a As Integer
Dim b As Integer
Set myrange = ActiveDocument.Range
'establish range to search
With myrange.Find
.Font.Bold = True
.Wrap = wdFindStop
If .Execute(findtext:="Abstract") Then Set findIn = myrange.Duplicate
myrange.Collapse wdCollapseEnd
myrange.End = ActiveDocument.Content.End
If .Execute(findtext:="References") Then findIn.End = myrange.Start
End With
findIn.Select
'search for inconsistencies
With findIn.Find
.MatchWholeWord = False
.Wrap = wdFindContinue
.Forward = True
If findIn.Duplicate.Find.Execute(findtext:="ageing") Then b = 1
If .Execute(findtext:="aging") Then a = 1
End With
If a = 1 And b = 1 Then
MsgBox "Both spellings of ageing found, please revise"
End If
End Sub
Related
I have a Word macro that does hundreds of find and replace operations, but currently it applies the operations to the entire document. I need it to only apply to text between "Abstract" (bold, match case) and "References" (bold, match case).
The current code applies changes to the whole document, and then at the end of the macro, it retrospectively rejects any changes to the References with the following code:
With Selection.Find
.ClearFormatting
.Font.Bold = True
.MatchCase = True
.Forward = True
.Execute FindText:="References"
If .Found = True Then
Selection.Find.Execute
Selection.Collapse wdCollapseStart
Dim r1 As Range
Set r1 = Selection.Range
Selection.Find.Text = "DummyText"
Selection.WholeStory
Selection.Collapse wdCollapseEnd
Dim r2 As Range
Set r2 = ActiveDocument.Range(r1.start, Selection.start)
r2.Select
If Selection.Range.Revisions.Count >= 1 Then _
Selection.Range.Revisions.RejectAll
End If
End With
This selects the text between "References" in bold and "DummyText", which is just some text that's guaranteed not to be found so it selects to the end of the document, and then rejects any changes within that selection.
I've tried adapting this and putting it at the start of the macro so that all the find and replace operations only apply to the selection between the Abstract and the References like this:
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Abstract"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.Font.Bold = True
.MatchCase = True
.MatchWholeWord = True
End With
Selection.Find.Execute
Selection.Collapse wdCollapseStart
Dim r1 As Range
Set r1 = Selection.Range
Selection.Find.Text = "References"
Dim r2 As Range
Set r2 = ActiveDocument.Range(r1.start, Selection.start)
r2.Select
' Move cursor to start, turn on tracked changes
Selection.HomeKey Unit:=wdStory
ActiveDocument.TrackRevisions = True
With ActiveWindow.View.RevisionsFilter
.markup = wdRevisionsMarkupSimple
.View = wdRevisionsViewFinal
End With
' start replacements (these go on for ages, two examples here)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Also "
.Replacement.Text = "Additionally, "
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Therefore "
.Replacement.Text = "Therefore, "
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
' and so on...
Other threads I've read seem to suggest
.Wrap = wdFindStop
in the replace fields would do what I want, but that doesn't work.
Can anybody help? Cheers.
For example:
Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "Abstract"
.Font.Bold = True
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
End With
Do While .Find.Execute
Set Rng = .Duplicate
With .Duplicate
.End = ActiveDocument.Range.End
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "References"
.Font.Bold = True
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
.Execute
End With
If .Find.Found = True Then
Rng.End = .Duplicate.End
Rng.Revisions.RejectAll
End If
End With
Loop
End With
Application.ScreenUpdating = True
End Sub
The above code accommodates multiple 'Abstract' and 'References' blocks, if needed.
You need to use multiple ranges. Once you have established the range to search then if you find something, the first thing you must do is make sure what you found is within the range. The example code below does that.
Sub FindInRange()
Dim rng As Word.Range, rStart As Long, rEnd As Long
Dim iRng As Word.Range
Set rng = ActiveDocument.Content
With rng.Find
.ClearFormatting
.Format = True
.Forward = True
.Font.Bold = True
.MatchCase = True
.MatchWholeWord = True
.Text = "Abstract"
.Wrap = wdFindStop
.Execute
If .found = True Then
rStart = rng.End
rng.Collapse Word.WdCollapseDirection.wdCollapseEnd
.Text = "References"
.Execute
If .found Then
rEnd = rng.Start
End If
End If
End With
If rStart > 0 And rEnd > 0 Then
Set iRng = rng
iRng.Start = rStart
iRng.End = rEnd
Else
Exit Sub
End If
Set rng = iRng
With rng.Find
.ClearFormatting
.Format = True
.Forward = True
.Font.Bold = True
.MatchCase = True
.MatchWholeWord = True
.Text = "Something"
.Wrap = wdFindStop
.Execute
If .found = True And rng.InRange(iRng) Then
'do something
End If
End With
End Sub
Is there a way for vba to find a string of text with a particular style and select until the style is used again? Or is there a way to find a string of text in a numbered list and select until the next number? The heading I want to find and select content under is "SUBMITTALS," but it is not always in the same numerical order in the document, but the style is always the same. Any advice would be appreciated, here is what I have tried:
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Heading 2")
With Selection.Find
.Text = "SUBMITTALS"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = True
End With
Selection.Find.Execute
Selection.Collapse wdCollapseStart
Dim r1 As range
Set r1 = Selection.range
'v = Selection.range.ListFormat.ListValue
'lstring = Selection.range.ListFormat.ListString
Selection.Find.Style = ActiveDocument.Styles("Heading 2")
With Selection.Find
.Text = "SUBMITTALS"
End With
Dim r5 As range
Set r5 = Selection.Next(wdSection).Next
'If Selection.Find.Execute Then
'Selection.Collapse wdCollapseStart
'Else
'Selection.WholeStory
'Selection.Extend
'Selection.Collapse wdCollapseEnd
'End If
Dim r2 As range
Set r2 = ActiveDocument.range(r1.Start, r5.Start)
r2.Select
For example:
Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "SUBMITTALS"
.Style = wdStyleHeading2
.Replacement.Text = ""
.Format = True
.Forward = True
.Wrap = wdFindStop
.Execute
End With
If .Find.Found = True Then
Set Rng = .Paragraphs(1).Range
Set Rng = RngHd.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
MsgBox Rng.Text
End If
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub
this is my first post here!
I am new to Microsoft VBA, but I need to write some macros to quickly make the same changes to 200+ documents. I took the Udemy course on Word VBA but I am stuck trying to figure out how to address the following issues:
I need to select all content from beginning of doc up until the first occurrence of the string "following:" including the string itself - the issue is that for each doc, this string will always be in a different position and the portion I want to delete will vary in length. The only guarantee is that it will always be on the first page.
I need to do the same thing for the end of the document - I need to delete all content following the string "Affirmative Defenses" including the string itself - again, this will always be in a different position and will not always be on the last page (unlike issue number 1)
I have written many variations by reading other questions/solutions with no luck. Below is my current version but it does not work.
Sub DeleteBegin()
Dim findRng As Range
Set findRng = ActiveDocument.Range
Dim endPara As Long
With findRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "following."
.Replacement.Text = ""
.Wrap = wdFindStop
.MatchWholeWord = True
.Forward = True
.Execute
If .Found = True Then
endPara = GetParaNum(findRng)
findRng.Start = 0
findRng.End = endPara
End If
Dim capRng As Range
Set capRng = ActiveDocument.Range
capRng.SetRange Start:=0, End:=endPara
capRng.Select
Selection.Delete
End With
End Sub
Function GetParaNum(ByRef r As Object) As Integer
Dim rPara As Object
Dim CurPos As Long
r.Select
CurPos = ActiveDocument.Bookmarks("\startOfSel").Start
Set rPara = ActiveDocument.Range(Start:=0, End:=CurPos)
GetParaNum = rPara.Paragraphs.Count
End Function
Try:
Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument
Set Rng = .Range(0, 0)
With .Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "following."
.Replacement.Text = ""
.Format = False
.Forward = True
.Wrap = wdFindStop
.Execute
End With
If .Find.Found = True Then
Rng.End = .Duplicate.End
Rng.Delete
End If
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "Affirmative Defenses"
.Replacement.Text = ""
.Format = False
.Forward = True
.Wrap = wdFindStop
.MatchCase = True
.Execute
End With
If .Find.Found = True Then
Set Rng = .Duplicate
Rng.End = ActiveDocument.Range.End
Rng.Delete
End If
End With
End With
Application.ScreenUpdating = True
End Sub
I am using the following code to bold parts of a text string, in this case where the word 'Fish' is in brackets after the word 'Oil':
Sub ReplaceAndFormat16()
Dim sConst1 As String, sReplaceMent As String
Dim rRange As Range, rFormat As Range
sConst1 = "Fish"
sReplaceMent = "Oil (" & sConst1 & ")"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Oil (Fish)"
.Replacement.Text = sReplaceMent
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceOne
If .Found Then
Set rRange = Selection.Range
Set rFormat = ActiveDocument.Range(rRange.Start + 5, rRange.Start + 5 + VBA.Len(sConst1))
rFormat.Font.Bold = True
End If
End With
End Sub
This code works perfectly, but only bolds the first instance, and my documents may have up to four instances of this phrase that need to be formatted bold.
How do I amend the code so it carries on and bolds all instances in the document? I am very new to VBA, so apologies if this seems like a stupid question.
Change the line
.Execute Replace:=wdReplaceOne
to
.execute Replace:=wdReplaceAll
Edit
OK the above was a stupid response. The code below does the right thing
Sub ReplaceAndFormat16()
Const myFindStr As String = "Oil (Fish)"
Dim myFindRange As Word.Range
Set myFindRange = ActiveDocument.StoryRanges(wdMainTextStory)
Do
With myFindRange.Find
.ClearFormatting
.Text = myFindStr
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
If .Found Then
With myFindRange
.MoveStartUntil cset:="fF"
.MoveEndUntil cset:="hH", Count:=wdBackward
.Font.Bold = True
.Collapse Direction:=wdCollapseEnd
End With
Else
Exit Sub
End If
End With
Loop
End Sub
Code to highlight italic text:
Sub Bold_Italic()
Dim rng As Range
Set rng = ActiveDocument.Range
rng.Collapse Direction:=wdCollapseStart
rng.Find.ClearFormatting
rng.Find.Font.Italic = True
rng.Find.Replacement.ClearFormatting
rng.Find.Replacement.Highlight = True
rng.Find.Replacement.Font.Color = wdColorRed
With rng.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
rng.Find.Execute Replace:=wdReplaceAll
End Sub
How can i highlight the whole paragraph or make selected for a paragraph?
Actually, i want to copy and paste paragraph by paragraph to another document.
I believe you're looking for range.select
Sub Macro()
Dim i As Integer
For i = 1 To ActiveDocument.Paragraphs.Count
Dim range As range
Set range = ActiveDocument.Paragraphs(i).range
'range.Characters.Count > 1 means there is text in the paragraph
If range.Characters.Count > 1 Then
'Handle the desired operation with the paragraph text
range.Select
MsgBox (range.Text)
End If
Next i
End Sub