Asked by:
Find and comment macro with wildcards

Question
-
While posting on the Microsoft community board, I got a tip that I should also post my issues here.
Recently I have experienced two problems with my macros, and I can not find a solution. It has been working fine in the past, but now it crashes. When I manually run the macro, it find and comments, but it does that infinitive times until it crashes.
The search strings that the macro is searching for are these:
Når [! ]@ var fremme Det [! ]@ var litt redd for Når [! ]@ kom inn i klasserommet Da [! ]@ kom inn i klasserommet Da [! ]@ våkna Når [! ]@ kom dit Da [! ]@ kom dit I sekundet [! ]@ gikk inn døra Med engang [! ]@ gikk inn døra Da [! ]@ kom hjem [! ]@ står opp av senga og det første jeg ser For at vi skal vite at det er eventyr Når [! ]@ trengte penger Alle dere som er her Hvis dere ikke gir meg penger Are any of you capable of spotting where the code is wrong?
My second problem is very similar. It's the same macro, but with different search strings and comments, but it duplicates the comment for each string it finds.
[Nn]år [! ]@ kom [Nn]år [! ]@ [a-å]@(et)> [Nn]år [! ]@ var [Nn]år [! ]@ fikk [Nn]år [! ]@ [! ]@ var [Nn]år [! ]@ har kommet [Nn]år [! ]@ [a-å]@(dde)> [Nn]år [! ]@ [a-å]@(te)> [Nn]år [! ]@ tok [Nn]år [! ]@ [a-å]@(a)> Sub kommafeil_bokmål()
'
'
'
' Søker igjennom alle feil som ligger under bokmål, rad I. Merker feil med rød.
' Rad 10
Application.ScreenUpdating = False
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String
Dim bStrt As Boolean, iDataRow As Long, bFound As Boolean
Dim xlFList As String, xlRList As String, i As Long, Rslt
StrWkBkNm = "\\sarpedia.sarpsborg.com\DavWWWRoot\arbeidsrom\enhet-gralum-ungdomsskole\Delte dokumenter\ord som ligger i makro.xlsx"
If Dir(StrWkBkNm) = "" Then
MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
Exit Sub
End If
' Sjekker om Excel er startet.
On Error Resume Next
bStrt = False ' Viser at excel er aktiv og vi kan stenge dette senere.
Set xlApp = GetObject(, "Excel.Application")
'Start Excel if it isn't running
If xlApp Is Nothing Then
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
MsgBox "Can't start Excel.", vbExclamation
Exit Sub
Else
End If
' Record that we've started Excel.
bStrt = True
End If
On Error GoTo 0
'Check if the workbook is open.
bFound = False
With xlApp
'Hide our Excel session
If bStrt = True Then .Visible = False
For Each xlWkBk In .Workbooks
If xlWkBk.FullName = StrWkBkNm Then ' It's open
Set xlWkBk = xlWkBk
bFound = True
Exit For
End If
Next
' If not open by the current user.
If bFound = False Then
' Check if another user has it open.
If IsFileLocked(StrWkBkNm) = True Then
' Report and exit if true
MsgBox "The Excel workbook is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
Exit Sub
End If
' The file is available, so open it.
Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm)
If xlWkBk Is Nothing Then
MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
Exit Sub
End If
End If
' Update the workbook.
With xlWkBk.Worksheets("bokmål")
' Find the last-used row in column A.
' Add 1 to get the next row for data-entry.
iDataRow = .Cells(.Rows.Count, 9).End(-4162).Row ' -4162 = xlUp
' Output the captured data.
For i = 1 To iDataRow
' Skip over empty fields to preserve the underlying cell contents.
If Trim(.Range("I" & i)) <> vbNullString Then
xlFList = xlFList & "|" & Trim(.Range("I" & i))
End If
Next
End With
If bFound = True Then xlWkBk.Close False
If bStrt = True Then .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
'Process each word from the List
For i = 1 To UBound(Split(xlFList, "|"))
With ActiveDocument.Range
With .Find
.Text = Split(xlFList, "|")(i)
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = False
.MatchCase = False
.MatchWildcards = True
.Replacement.Highlight = True
.Wrap = wdFindStop
.Execute
End With
'Replace the found text, asking first
Do While .Find.Found
i = i + 1
.Duplicate.Select
.Comments.Add Range:=.Duplicate, Text:="Alltid komma når en leddsetning står først i en helsetning"
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Next
Application.ScreenUpdating = True
End SubMonday, May 15, 2017 6:39 AM
All replies
-
Your '.Duplicate.Select' line is redundant and would markedly slow down the code's execution, possibly even to the point of making it appear Word has stopped working; otherwise it doesn't affect the code's operation. Even if you delete that unnecessary line, if there are large amounts of Find/Replace going on, Word may appear to lock up, so it might be worthwhile inserting:
DoEvents
before the final:
Next
The code doesn't go into an infinite loop for me, though I didn't try it will all your Find/Replace expressions.Cross-posted at: https://answers.microsoft.com/en-us/msoffice/forum/msoffice_word-msoffice_custom/find-and-comment-macro-with-wildcards/f4fe75c9-70e8-4342-ad4a-403196e7bdf1#LastReply
For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184
Cheers
Paul Edstein
[MS MVP - Word]- Edited by macropodMVP Tuesday, May 16, 2017 9:15 AM Cross-post notice
- Proposed as answer by Steve Fan Monday, May 22, 2017 10:06 AM
Tuesday, May 16, 2017 4:04 AM