简体   繁体   中英

Excel VBA code to compare text strings in two columns and highlight certain text strings not the whole cell?

I need to do a vba code to compare texts in two columns and highlight matched texts in the second column. I started on the code and below is what I got so far. It works fine on the first row, how to modify the code to apply this for the entire table not just the first row. I'm new to VBA and any help would be great.

Sub Test1()
  Dim strString$, x&
  Dim rngCell As Range

  strString = Range("G2").Value
  Application.ScreenUpdating = False
  For Each rngCell In Range("S2", Range("S" & Rows.Count).End(xlUp))
      With rngCell
          .Font.ColorIndex = 1
          For x = 1 To Len(.Text) - Len(strString) Step 1
              If Mid(.Text, x, Len(strString)) = strString Then .Characters(x, Len(strString)).Font.ColorIndex = 5
          Next x
      End With
  Next rngCell
  Application.ScreenUpdating = True
End Sub

If your code works correctly on the first row (I haven't tested it, so will just trust that you are correct), then the following is, I think, what you want to change:

Sub Test1()
  Dim strString$, x&
  Dim rngCell As Range

  Application.ScreenUpdating = False
  For Each rngCell In Range("S2", Range("S" & Rows.Count).End(xlUp))
      With rngCell
          .Font.ColorIndex = 1
          strString = Cells(rngCell.Row, "G").Value
          For x = 1 To Len(.Text) - Len(strString) Step 1
              If Mid(.Text, x, Len(strString)) = strString Then .Characters(x, Len(strString)).Font.ColorIndex = 5
          Next x
      End With
  Next rngCell
  Application.ScreenUpdating = True
End Sub

ie move the calculation of strString inside the loop and base it on the value in column G of the row being processed.

I just gave someone this answer to a very similar question ...

Sub ColorMatchingString()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1)
    Dim strTest As Collection: Set strTest = New Collection
    Dim udRange As Range: Set udRange = ws.Range("AC2:AC311") 'Define Search Ranges
    Dim myCell, myMatch, myString, i
    Dim temp() As String, tempLength As Integer, stringLength As Integer
    Dim startLength as Integer

    For Each myMatch In udRange 'Build the collection with Search Range Values
        strTest.Add myMatch.Value
    Next myMatch

    For Each myCell In ws.Range("A2:AB1125") 'Loop through each cell in range
        temp() = Split(myCell.Text, ", ") 'define our temp array as "," delimited
        startLength = 0
        stringLength = 0

        For i = 0 To UBound(temp) 'Loop through each item in temp array
            tempLength = Len(temp(i))
            stringLength = stringLength + tempLength + 2

            For Each myString In strTest
  'Below compares the temp array value to the collection value. If matched, color red.
                If StrComp(temp(i), myString, vbTextCompare) = 0 Then 
                    startLength = stringLength - tempLength - 1
                    myCell.Characters(startLength, tempLength).Font.Color = vbRed
                End If
            Next myString
        Next i
        Erase temp 'Always clear your array when it's defined in a loop
    Next myCell
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM