

Find matching strings in the same text string separated by a word using the word...
source link: https://www.codesd.com/item/find-matching-strings-in-the-same-text-string-separated-by-a-word-using-the-word-office-vba.html
Go to the source link to view the article. You can view the picture content, updated content and better typesetting reading experience. If the link is broken, please click the button below to view the snapshot at that time.

Find matching strings in the same text string separated by a word using the word office vba
I need your help on this problem. I'm trying to write a VBA Macro in Office Word that will search for defined strings in the document text. That was straightforward for me to achieve. The particularity now is If in the text some strings are separated by a word, then make a match.
Here is the basic code to find matching strings in the doc but I'm struggling to figure out how to make a match on one word separated strings.
Sub HighlightMatches()
Dim range As range
Dim i As Long
Dim wordsArray
wordsArray = Array("Lion", "Hello", "Cat", "Lorem Ipsum")
For i = 0 To UBound(wordsArray)
Set range = ActiveDocument.range
With range.Find
.Text = wordsArray(i)
.Format = True
.MatchCase = False
Do While .Execute(Forward:=True) = True
range.HighlightColorIndex = wdYellow
Loop
End With
Next
End Sub
What I'm trying to achieve: If in the document text there is a sentence like "Lorem is Ipsum and that's all"; I would like the search to highlight "Lorem is Ipsum" even if "lorem is Ipsum" is not in the wordsArray.
I will be thankfull if you guys can help me with this. Thanks in advance for your time.
The strings, separated by word are easy to be found - try to split the string and then count the units in the array. In general, assuming that you can achieve that easily and summarizing your problem to find a match when I have two words with a random word in between this would pretty much do what you need:
Option Explicit
Public Sub TestMe()
Dim strText As String
Dim arrMatches As Variant
Dim arrIn As Variant
Dim myArr1 As Variant
Dim myArr2 As Variant
Dim lngC As Long
arrMatches = Array(Array("lorem", "ipsum"), Array("of", "the"))
strText = "lorem my ipsum is simply dummy text of fu the printing " & _
"and typesetting industry."
arrIn = Split(strText)
'we need to check always 2 less:
For lngC = LBound(arrIn) To UBound(arrIn) - 2
For Each myArr1 In arrMatches
If myArr1(0) = arrIn(lngC) And myArr1(1) = arrIn(lngC + 2) Then
Debug.Print arrIn(lngC) & " " & arrIn(lngC + 1) & " " & arrIn(lngC + 2)
End If
Next myArr1
Next lngC
End Sub
It is probably difficult to understand what it does, thus change the arrMatches
a few times and the strText
as well. Then debug with F8
. In this case it returns in the immediate window the following:
lorem my ipsum
of fu the
This is because we have 2 arrMatches Array(Array("lorem", "ipsum"), Array("of", "the"))
and the only strings in the text, where these matches are present with a word between them are the one above.
Edit: If you want to make it working for more than 1 word in between, check it like this:
Option Explicit
Public Sub TestMe()
Dim strText As String
Dim strPrint As String
Dim arrMatches As Variant
Dim arrInput As Variant
Dim myArr1 As Variant
Dim myArr2 As Variant
Dim lngC As Long
Dim lngC2 As Long
Dim lngC3 As Long
arrMatches = Array(Array("lorem", "ipsum"), Array("of", "the"))
strText = "lorem my ipsum is simply dummy text of fu the printing " & _
"ipsum and typesetting industry."
arrInput = Split(strText)
For lngC = LBound(arrInput) To UBound(arrInput)
For Each myArr1 In arrMatches
For lngC2 = lngC To UBound(arrInput)
If myArr1(0) = arrInput(lngC) And myArr1(1) = arrInput(lngC2) Then
strPrint = ""
For lngC3 = lngC To lngC2
strPrint = strPrint & " " & arrInput(lngC3)
Next lngC3
Debug.Print strPrint
End If
Next lngC2
Next myArr1
Next lngC
End Sub
Recommend
About Joyk
Aggregate valuable and interesting links.
Joyk means Joy of geeK