![]() |
#1
|
|||
|
|||
![]()
I've come across an issue with the code I use to format a set of definitions into our house style. At the moment the code I use (not the below code) only looks for the the word 'means' and inserts a tab before it but Definition wording often has other common words e.g. 'incudes', 'has the meaning' or 'any' so when I run the code these remain unchanged.
Would the best approach be to put these words into an array to look for the first instance in each paragraph and insert a tab before them. I'm trying to get the code below to work. Am I on the right track or is there a simpler way to achieve what I need the code to do? Before Before.JPG After After.JPG Before - Insert Tab.docx Code:
Sub InsertTab_Before_FirstInstance() Dim oRng As Word.Range Dim arrWords Dim i As Long arrWords = Array("means", "includes", "has", "any") For i = 0 To UBound(arrWords) Set oRng = ActiveDocument.Range With oRng.Find .ClearFormatting .Replacement.ClearFormatting .text = arrWords(i) .MatchWholeWord = True .Replacement.text = ChrW(9) & arrWords(i) .Execute Replace:=wdReplaceOne End With Next End Sub |
#2
|
|||
|
|||
![]()
Hi, Shelley Lou! The following code will do the job if there's only one array item in each paragraph. If there's more than one array item (i.e. not instances of the same item but different items) in a para, the first instance of each item will be worked on. To avoid this, the array item with the least Start number should be selected, which will require comparing all found items. This will complicate the code. One tip: I'd use array items as long as possible to avoid false hits, eg "means" may be found in different collocations.
Code:
Sub InsertTab_Before_FirstInstance() Dim oRng As range Dim oPar As Paragraph Dim arrWords Dim i As Long Set oRng = ActiveDocument.range arrWords = Array("means", "includes (without", "any part") For Each oPar In oRng.Paragraphs For i = 0 To UBound(arrWords) With oPar.range.Find .ClearFormatting .Replacement.ClearFormatting .text = arrWords(i) .MatchWholeWord = True .Replacement.text = ChrW(9) & arrWords(i) .Execute Replace:=wdReplaceOne End With Next i Next oPar End Sub |
#3
|
|||
|
|||
![]()
Hi Vivka, unfortunately I can't get the code to work. Also with regard to adding extra wording in the array won't work e.g. includes (without, as all conversions/definitions are different. So I just need to find the very first instance in each paragraph of the array words. Thank you so much for responding though, its definitely a work in progress.
|
#4
|
|||
|
|||
![]()
Shelley Lou, Vivka
While a "Find and Replace" solution might be defined for this problem, I think it would be fairly complex. I sense that the amount of text to check is not in the range of say War and Peace so this method may work: Code:
Sub InsertTab_Before_FirstInstance() Dim arrWords Dim oCol As New Collection Dim lngIndex As Long Dim lngPar As Long Dim oWord As Range 'Define the words to trigger first instance. arrWords = Split("means|includes|any|has", "|") 'Add first instance words to a keyed collection. Note-once added, the same word can't be added again. For lngIndex = 0 To UBound(arrWords) oCol.Add arrWords(lngIndex), arrWords(lngIndex) Next lngIndex 'Look at each paragraph For lngPar = 1 To ActiveDocument.Paragraphs.Count 'Look at each word starting with first word For Each oWord In ActiveDocument.Paragraphs(lngPar).Range.Words On Error Resume Next 'Attempt to add word to collection oCol.Add Trim(oWord), Trim(oWord) If Err.Number = 0 Then 'If you can add it, there will be no error. Remove the word oCol.Remove oCol.Count Else 'If you can't then it is a first instance word. Prefix the tab If oWord.Characters.First.Previous = " " Then oWord.Characters.First.Previous.Delete oWord.InsertBefore Chr(9) Err.Clear GoTo Next_Par End If Next oWord Next_Par: Next lngPar lbl_Exit: Exit Sub End Sub |
#5
|
|||
|
|||
![]()
Greg, thank you for an interesting solution!
|
#6
|
|||
|
|||
![]()
Vivka,
Thanks. I didn't have time yesterday to delve into a FR solution. Here is one that seems to work. I'm not confident it is any better than the solution posted yesterday: Code:
Sub InsertTab_Before_FirstInstance() Dim oPar As Paragraph Dim oRng As Word.Range, oFIRng As Range Dim arrWords Dim i As Long, j As Long arrWords = Array("means", "includes", "has", "any") For Each oPar In ActiveDocument.Range.Paragraphs Set oFIRng = Nothing Set oRng = oPar.Range j = 0 Do For i = j To UBound(arrWords) oRng.Start = oPar.Range.Start With oRng.Find .ClearFormatting .Replacement.ClearFormatting .Text = arrWords(i) .MatchWholeWord = True If .Execute Then 'We have found a first instance word. But, does another FI word precede it? Set oFIRng = oRng.Duplicate End If 'Index and look for next word in the array j = j + 1 If j = UBound(arrWords) + 1 Then Exit Do End With Next i If oFIRng Is Nothing Then Exit Do Loop If Not oFIRng Is Nothing Then If oFIRng.Characters.First.Previous = " " Then oFIRng.Characters.First.Previous.Delete If Not oFIRng.Characters.First.Previous = Chr(9) Then oFIRng.InsertBefore Chr(9) End If Next lbl_Exit: Exit Sub End Sub |
#7
|
|||
|
|||
![]()
Greg, thank you for another great lesson! Both codes are awesome!
|
#8
|
|||
|
|||
![]()
Thanks. I thought I would refine and comment a bit:
Code:
Sub InsertTab_Before_FirstInstance() Dim oPar As Paragraph Dim oRng As Word.Range, oFIRng As Range Dim arrWords Dim lngIndex As Long, lngListIndex As Long 'Purpose - to find and prefix the first instance of any word (defined from a list) in each document paragraph define. 'The number of possible words is variable and defined in an array. arrWords = Array("means", "includes", "has", "any") 'Look in each paragraph For Each oPar In ActiveDocument.Range.Paragraphs 'Define the oFIRng Set oFIRng = Nothing 'Note - if oFIRng remains nothing at the end of this looop then none of the possible words where found. 'Set the search range variable Set oRng = oPar.Range 'Initialize\reset the counter lngListIndex = 0 Do 'We are entering a Do ... Loop and we stay in this loop until we have looked in the defined range 'for all the listed words. For lngIndex = lngListIndex To UBound(arrWords) 'Ensure the search range allows starts at the start of the paragraph oRng.Start = oPar.Range.Start With oRng.Find 'Note the search range is always from the start of the paragraph to end of the paragraph 'or end of the last word found. .ClearFormatting .Replacement.ClearFormatting .Text = arrWords(lngIndex) .MatchWholeWord = True If .Execute Then 'We have found a first instance word. Set oFIRng = oRng.Duplicate 'Note oRng.End is now defined at then end of the found word. End If 'Found yes, but does one of the other FI words in the list precede it? 'Index the counter look for next word in the array lngListIndex = lngListIndex + 1 If lngListIndex = UBound(arrWords) + 1 Then 'We have looked for the last word in the list. Escape the Do ... Loop Exit Do End If End With Next lngIndex Loop 'Was a listed word found? If Not oFIRng Is Nothing Then If oFIRng.Characters.First.Previous = " " Then oFIRng.Characters.First.Previous.Delete If Not oFIRng.Characters.First.Previous = Chr(9) Then oFIRng.InsertBefore Chr(9) End If Next lbl_Exit: Exit Sub End Sub |
#9
|
|||
|
|||
![]()
THANK YOU, Greg! You are one of my TEACHERS! I'm sure, Shelley Lou will use better superlatives.
|
#10
|
|||
|
|||
![]()
Wow Greg this code is amazing, thank you so much, I didn't expect anything like this.
I've been testing it on all the house style documents I have had to convert over the past couple of days. The only thing I would add to the code if possible is to get the code to ignore any sublevels, e.g. (a), (i), etc. as the code does add a tab if the array words are present to those but wow, very happy and thank you for the time you've put into this. Before.JPG |
#11
|
|||
|
|||
![]()
Shelley,
Of course that could be accommodated. I assume that you are using styles in your documents and or list paragraphs. You could add code to process only a) certain styles or b) paragraphs that are not list paragraphs: For Each oPar In ActiveDocument.Range.Paragraphs 'If oPar.Style = "Normal" Then 'or If oPar.Range.ListFormat.ListType = wdListNoNumbering Then 'Existing code End If Next |
#12
|
|||
|
|||
![]()
Hi Greg, no styles are being used at this stage of the conversion, it is just unformatted text so each sub level (a), (i) etc. is manual - I know the stance is to use styles but this code will be a call in as part of my bigger code which does all the rest of the formatting. I will try adding your extra bit of code in to see if I can get it working.
|
#13
|
|||
|
|||
![]()
Shelley,
Try: For Each oPar In ActiveDocument.Range.Paragraphs If Not oPar.Range.Characters(1) Like ("[a-z1-9([]") Then 'Existing code End If Next |
#14
|
|||
|
|||
![]()
Hi Greg, apologies for the late response, thank you for the extra bits to add to the code, this worked really well so thank you, much appreciated
|
![]() |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
Shelley Lou | Word VBA | 2 | 03-08-2023 03:15 AM |
![]() |
laith93 | Word VBA | 6 | 10-28-2022 01:12 AM |
![]() |
benfarley | Word VBA | 1 | 03-30-2022 08:35 PM |
An array of words from a document knowing the font style | Kreol2013 | Word VBA | 0 | 07-08-2013 01:29 AM |
![]() |
tinfanide | Excel Programming | 4 | 12-26-2012 08:56 PM |