#1
|
|||
|
|||
Highlight words in a table that does not exist in current document
May everyone be well,
Please I have more than 220 abbreviations (> 8 pages) in my thesis, and I created them when I was starting writing my thesis, but after multiple editing by the supervisor, now she asked me to delete any unused abbreviations. look I have a table for abbreviations 141.png So if possible I want a VBA code that searches for the abbreviations in the current document by using column A of my table, and if exists doesn't make changes, but if absent highlight the abbreviation in order to delete it later. I hope you understand what I want, and I'm ready for any other solution to my problem. Thank you |
#2
|
||||
|
||||
If the abbreviation in your document does not exist in the table, how is the macro supposed to know that it is an abbreviation?
You could perhaps search for all the items in your table and highlight the ones that do exist in the document, which might make those not present easier to spot manually (see below), but given that even in your table sample there are 13 different formats that reflect abbreviation types, producing a macro to identify all of these and the other 200+ formats that may exist is hardly practical. Code:
Option Explicit Sub FindAbbr() Const sAbbrDoc As String = "C:\Path\Abbreviations.docx" 'the path of the abbreviations table document Dim oDoc As Document, oAbbr As Document Dim oTable As Table Dim oRng As Range Dim i As Long If MsgBox("This could take some time!", vbOKCancel + vbInformation) = vbCancel Then MsgBox "User cancelled", vbInformation GoTo lbl_Exit End If Set oDoc = ActiveDocument Set oAbbr = Documents.Open(sAbbrDoc) Set oTable = oAbbr.Tables(1) For i = 1 To oTable.Rows.Count Set oRng = oTable.Cell(i, 1).Range oRng.End = oRng.End - 1 Find_Replace oDoc, oRng.Text, "^&", False, True, True DoEvents Next i oAbbr.Close 0 MsgBox "Search complete", vbInformation lbl_Exit: Set oDoc = Nothing Set oAbbr = Nothing Set oTable = Nothing Set oRng = Nothing Exit Sub End Sub Private Sub Find_Replace(ByRef oDoc As Word.Document, _ ByRef strFind As String, _ ByRef strReplace As String, _ Optional ByRef bMatchWC As Boolean, _ Optional ByRef bMatchCase As Boolean, _ Optional ByRef bFWWO As Boolean) Dim rngStory As Word.Range Dim oShp As Shape For Each rngStory In oDoc.StoryRanges Select Case rngStory.StoryType Case 1 To 11 Do SrcAndRplInStory rngStory, strFind, strReplace, _ bMatchWC, bMatchCase, bFWWO On Error Resume Next DoEvents On Error GoTo 0 Select Case rngStory.StoryType Case 6, 7, 8, 9, 10, 11 If rngStory.ShapeRange.Count > 0 Then For Each oShp In rngStory.ShapeRange If oShp.TextFrame.HasText Then SrcAndRplInStory oShp.TextFrame.TextRange, _ strFind, strReplace, _ bMatchWC, bMatchCase, bFWWO End If DoEvents Next oShp End If Case Else 'Do Nothing End Select On Error GoTo 0 'Get next linked story (if any) Set rngStory = rngStory.NextStoryRange Loop Until rngStory Is Nothing Case Else End Select DoEvents Next rngStory lbl_Exit: Set rngStory = Nothing Exit Sub err_Handler: Resume lbl_Exit End Sub Private Sub SrcAndRplInStory(ByVal rngStory As Word.Range, _ ByVal strSearch As String, _ ByVal strReplace As String, _ ByVal bMatchWildCards As Boolean, _ ByVal bMatchCase As Boolean, _ ByVal bFindWWO As Boolean) With rngStory.Find .ClearFormatting .Replacement.ClearFormatting .Text = strSearch .Replacement.Text = strReplace .Replacement.Highlight = True .MatchWildcards = bMatchWildCards .MatchCase = bMatchCase .MatchWholeWord = bFindWWO .Execute Replace:=wdReplaceAll End With lbl_Exit: Exit Sub End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
|||
|
|||
Quote:
Thank you for your effort and time Thank you for this huge and complex code Firstly, My bro, I'm sure by 100% that every abbreviation in the table was used in my thesis, but as the supervisor each time delete many paragraphs and these paragraphs may contain certain abbreviations in the table. At the end, I want to filter the table to delete any unused abbreviation (deleted by the supervisor). Secondly, As the operation depends on two files, the abbreviations table file and my thesis file (active document) I think you are misunderstanding me, because the result of the code, highlight the abbreviations in the active file, not in the abbreviations table, see below 142.png So, I want to highlight the unused abbreviations in my table not in my thesis's paragraphs, in order to rapid recognizing and delete it from the table. Thank you again |
#4
|
||||
|
||||
As I said, the difficulty is in establishing in the document what are the abbreviations, which, as far as VBA is concerned, are just random text strings. I can see no consistent way to isolate the abbreviations in the document. They are not even all surrounded by brackets which could have been helpful.
The macro checks each of your listed abbreviations in the table against the document and highlights them. This would then allow you to look through the document to establish which items are not highlighted and therefore missing from the table. If you then add those items to the table and re-run the macro you will get all the abbreviations highlighted in the document. Then it would be possible to interrogate the document for the highlighted items and highlight the items in the table that were found in the document. e.g. Code:
Sub Macro2() Const sAbbrDoc As String = "C:\Path\Abbreviations.docx" 'the path of the abbreviations table document Dim oDoc As Document, oAbbr As Document Dim oRng As Range Dim i As Long Options.DefaultHighlightColorIndex = wdYellow Set oDoc = ActiveDocument Set oAbbr = Documents.Open(sAbbrDoc) Set oRng = oDoc.Range With oRng.Find .ClearFormatting .Replacement.ClearFormatting .Highlight = True .MatchWildcards = False Do While .Execute SrcAndRplInStory oAbbr.Tables(1).Range, oRng.Text, "^&", False, False, False oRng.Collapse 0 Loop End With lbl_Exit: Set oDoc = Nothing Set oAbbr = Nothing Set oRng = Nothing Exit Sub End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#5
|
||||
|
||||
The coding for this is going to be simplest if you (temporarily) paste the abbreviations table into the main document to run this code. This code assumes you pasted the table at the very end of the document.
Code:
Sub CheckAcroInUse() Dim aTbl As Table, sAbb As String, aRng As Range, aCell As Cell Set aTbl = ActiveDocument.Tables(ActiveDocument.Tables.Count) Set aRng = ActiveDocument.Range(0, aTbl.Range.Start) For Each aCell In aTbl.Columns(1).Cells sAbb = Split(aCell.Range.Text, vbCr)(0) If InStr(aRng.Text, sAbb) = 0 Then aCell.Range.HighlightColorIndex = wdYellow End If Next aCell End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#6
|
||||
|
||||
That would work, but only if all the abbreviations in the document were listed in the table, and as I understood it, that may not be the case.
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#7
|
|||
|
|||
Quote:
However, I faced this problem when running your code: 143.png Furthermore, during waiting time I googled and found this code from HTML Code:
https://wordribbon.tips.net/T001173_Highlight_Words_from_a_Word_List.html Code:
Sub CompareWordList() Dim sCheckDoc As String Dim docRef As Document Dim docCurrent As Document Dim wrdRef As Object sCheckDoc = "c:\checklist.doc" Set docCurrent = Selection.Document Set docRef = Documents.Open(sCheckDoc) docCurrent.Activate With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Replacement.Font.Bold = True .Replacement.Text = "^&" .Forward = True .Format = True .MatchWholeWord = True .MatchCase = True .MatchWildcards = False End With For Each wrdRef In docRef.Words If Asc(Left(wrdRef, 1)) > 32 Then With Selection.Find .Wrap = wdFindContinue .Text = wrdRef .Execute Replace:=wdReplaceAll End With End If Next wrdRef docRef.Close docCurrent.Activate End Sub HTML Code:
https://stackoverflow.com/questions/49292384/highlight-words-microsoft-word-from-checklist-and-highlight-matching-words-in-c |
#8
|
|||
|
|||
Quote:
Amazing and fantastic Which brain do you have That is exactly what I want Thank you so much Mr. Andrew My abbreviations table is already present in the active document, I just moved it temporarily to the end of the document. Thank you again Best whishes |
Tags |
word vba, word vba code, word vba highlight text |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Find and highlight multiple words in MS Word document | AtaLoss | Word VBA | 37 | 09-22-2021 12:04 PM |
How to redact words listed in one document from the current document | AlanofBayCourt | Word VBA | 0 | 10-31-2019 03:00 AM |
Find and highlight multiple words in MS Word document | qkjack | Word VBA | 7 | 02-21-2018 07:09 PM |
Using VBA to Compare and Highlight words in a Word Table's Row/Cell | KeithLee22 | Word VBA | 2 | 11-11-2015 03:37 PM |
Find and highlight multiple words in a document | flatop | Word VBA | 3 | 04-16-2014 10:29 PM |