Word 2013 - Macro to Highlight Excel List of Prepositions Only at End of Sentences

[kad]

I would like to create a macro that highlights prepositions if they occur as the last word in a sentence (i.e., the last word before a period, question mark, or exclamation point).

I have a macro that finds and replaces from an Excel spreadsheet list of words, but I can't figure out how to adapt it to find prepositions at the end of a sentence. Any help would be greatly appreciated :)

-Kad


Sub FindReplace()'
' FindReplace Macro
'


Const strXLFile = "C:\Users\kate.dupuis\Desktop\Templates\Replacements.xls"
Dim xlApp As Object
Dim xlWbk As Object
Dim xlWsh As Object
Dim blnStart As Boolean
Dim r As Long
Dim m As Long


On Error Resume Next
' Get or start Excel
Set xlApp = GetObject(, "Excel.Application")
If xlApp Is Nothing Then
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
MsgBox "Can't start Excel.", vbExclamation
Exit Sub
End If
blnStart = True
End If


On Error GoTo ErrHandler


Application.ScreenUpdating = False
' Open workbook
Set xlWbk = xlApp.Workbooks.Open(strXLFile)
' Reference to first worksheet
Set xlWsh = xlWbk.Worksheets(1)
' Get last used row
m = xlWsh.Cells(xlWsh.Rows.Count, 1).End(-4162).Row


With ActiveDocument.Content.Find
' Initialize find/replace settings
.ClearFormatting
.Replacement.ClearFormatting
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
' Loop through rows
For r = 1 To m
' Get text to find
.Text = xlWsh.Cells(r, 1)
' And replacement
.Replacement.Text = xlWsh.Cells(r, 2)
' Replace all
.Execute Replace:=wdReplaceAll
Next r
End With


ExitHandler:
' Clean up
On Error Resume Next
Set xlWsh = Nothing
xlWbk.Close savechanges:=False
Set xlWbk = Nothing
If blnStart Then
xlApp.Quit
End If
Set xlApp = Nothing
Application.ScreenUpdating = True
Exit Sub


ErrHandler:
' Inform user
MsgBox Err.Description, vbExclamation
' And go to cleanup section
Resume ExitHandler
End Sub

[macropod]

You could use something like the following. Do be aware, though, that Word VBA has no idea what a grammatical sentence is.

Sub CheckPrepositions()
Application.ScreenUpdating = False
Dim strPreps As String
strPreps = ",as,at,by,for,from,in,of,on,to,with,"
With ActiveDocument.Content
With .Find
.Text = "<[A-Za-z]@[,.\!\?:;]"
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchWildcards = True
.Execute
End With
Do While .Find.Found = True
If InStr(strPreps, "," & .Text) > 0 Then
.End = .End - 1
.HighlightColorIndex = wdYellow
End If
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = False
End Sub

[gmaxey]

Here is another variant:


Sub CheckPrepositions()
Dim strPreps() As String
Dim lngIndex As Long
Dim oRng As Word.Range
Application.ScreenUpdating = False
strPreps = Split("as,at,by,for,from,in,of,on,to,with", ",")
For lngIndex = 0 To UBound(strPreps)
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "<" & strPreps(lngIndex) & "[,.\!\?:;]"
.Forward = True
.Wrap = wdFindStop

.Format = True
.MatchWildcards = True
While .Execute
oRng.End = oRng.End - 1
oRng.HighlightColorIndex = wdYellow
oRng.Collapse wdCollapseEnd
Wend
End With
Next lngIndex
Application.ScreenUpdating = False
End Sub

[kad]

Thanks guys, both worked really well :) -kad