Instr function only on specific font-CodePudding

I´m trying to find a way to use Instr to work only with words that have a specific font.

I´m currently using a code that allows me to find differences between two paragraphs and show the changes on another column by chainging the words that are the same to the color green. The problem is that when using Instr it only finds the first occurence of a word. But with the paragraphs I´m using, the words appear multiple times:

   myLastRow = Cells(Rows.Count, "G").End(xlUp).Row

        For I = 3 To myLastRow
            
     strTemp = " "
    WordsA = Split(Range("F" & I).Text, " ")
    
    Debug.Print WordsA
    WordsB = Split(Range("H" & I).Text, " ")
    Debug.Print WordsB
    
    For ndxB = LBound(WordsB) To UBound(WordsB)
    For ndxA = LBound(WordsA) To UBound(WordsA)
    
        If StrComp(WordsA(ndxA), WordsB(ndxB), vbTextCompare) = 0 Then

    FindText = WordsA(ndxA)
    Debug.Print FindText

    
    Set TextRange = Range("H" & I)
    fontColor = 4
    'FindText.Font.ColorIndex = fontColor
    
    For Each part In TextRange
    
        lenOfpart22 = InStr(1, TextRange, FindText, 1)
        
        lenPart = Len(FindText)

                part.Characters(Start:=lenOfpart22, Length:=lenPart).Font.ColorIndex = fontColor
                
    Next part


    
                Exit For
            End If
        Next ndxA
    Next ndxB
    

      
        Next I

What I need is for the Instr to only search the word if its fond is 0 (black).

TextRange is the paragraph. Usually more than 500 caracters long FindText is the word that I´m searching

This is an example of the problem I´m having:

In this paragraph you can see how some words appear in green. These are the words that are the same on the two paragraphs that I´m comparing (columns F and G). There are some words such as: aeqqw, SAWR, SIGMEL... that are different. The problem is that Instr only finds the first occurrence of a word. That´s why I want a condition were if the word is green, it won´t be considered in the instr and will move on to find the next word.

In the picture you can see that the first "El" is in green, but the rest aren´t. This is because when it searches for the second, thrid, fourth... "el" it comes back to the first "el".

CodePudding user response：

Please, use the next function to do what (I understood) you need:

Sub WordsCompare(cell1 As Range, cell2 As Range)
    Dim arr1, arr2, arrMtch, mtch, El, strArr As String, i As Long, j As Long, k As Long
    
    arr1 = Split(cell1.value): arr2 = Split(cell2.value) 'split the two cells content by words

    For Each El In arr1                            'iterate between the first cell words
        mtch = Application.match(El, arr2, 0)      'check if the word exists in the other array(range)
        If IsNumeric(mtch) Then                    'iterate only if a match is found
            For i = 0 To UBound(arr2)
                If arr2(i) = El Then               'when the word has been found:
                    arrMtch = Split(cell2, , i   1, vbTextCompare) 'split the range only up to the searched word (plus the rest of the string)
                    'eliminate the last element of the array:
                    arrMtch(UBound(arrMtch)) = "@#$%": arrMtch = filter(arrMtch, "@#$%", False)
                    
                    strArr = Join(arrMtch, "|")   'join the array elements to obtain the necessary (Long) start, before the word to be colored
                    cell2.Characters(start:=Len(strArr)   2, length:=Len(El)).Font.Color = vbGreen '  2 because of the 1D zero based array and a space
                End If
            Next i
        End If
    Next
End Sub

The above Sub should be called by the next one:

Sub testWordsCompare()
  Dim ws As Worksheet, rng As Range, lastR As Long, i As Long
  
  Set ws = ActiveSheet
  lastR = ws.Range("F" & ws.rows.count).End(xlUp).row
  Set rng = ws.Range("F2:G" & lastR)
    rng.Columns(2).Font.Color = 0 'make the font color black (default)
    
  For i = 1 To rng.rows.count
         WordsCompare rng.rows(i).cells(1, 1), rng.rows(i).cells(1, 2)
  Next i
  MsgBox "Ready..."
End Sub

Sub testWordsCompare()
  Dim ws As Worksheet, rng As Range, lastR As Long, i As Long
  
  Set ws = ActiveSheet
  lastR = ws.Range("F" & ws.rows.count).End(xlUp).row
  Set rng = ws.Range("F2:G" & lastR)
    rng.Columns(2).Font.Color = 0 'make the font color black (default)
    
  Application.EnableEvents = False: Application.ScreenUpdating = False
  For i = 1 To rng.rows.count
         WordsCompare rng.rows(i).cells(1, 1), rng.rows(i).cells(1, 2)
  Next i
  Application.EnableEvents = True: Application.ScreenUpdating = True
  
  MsgBox "Ready..."
End Sub

The function should be also updated for cases of punctuation (comma, dot, question mark, ":", ";" etc.) which is not so complicate, I would say. I tried it without punctuation and it works as it should.

Please, test it and send some feedback. Eventually, the punctuation problem if difficult to solve it by yourself...

CodePudding user response：

This is an example of the problem I´m having:

In this paragraph you can see how some words appear in green. These are the words that are the same On the two paragraphs that I´m comparing. There are some words such as: aeqqw, SAWR, SIGMEL... that are different. The problem is that Instr only finds the first occurance of a word. That´s why I want a condition so if the word is green, it won´t be considered and will move on to the next word.