6

Find matching strings in the same text string separated by a word using the word...

 3 years ago
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

advertisements

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


About Joyk


Aggregate valuable and interesting links.
Joyk means Joy of geeK