Formatting List of Text Strings in Excel

0
votes

I am trying to turn the font to red for the occurrences of a list of words in excel. So far, I am able to find a single word, but I need to search for a whole array. I am a newbie with VBA and struggling. So far, I've been able to find this as a solution, but it deals with finding a single string, "F1":

Sub test4String2color()
Dim strTest As String
Dim strLen As Integer
strTest = Range("F1")
For Each cell In Range("A1:D100")
If InStr(cell, strTest) > 0 Then
cell.Characters(InStr(cell, strTest), strLen).Font.Color = vbRed
End If
Next
End Sub

Edit:

The cells I need highlighted have the items listed in comma separated format. For example, "Apple 1, Apple 3, Banana 4, Orange". The list of values to search from are in Different cells, "Apple", "Banana 4". I only want to highlight "Banana 4" because this is an EXACT match with the comma separated values. In the current formulation, the text that says "Apple 1" or "Apple 4" would be partially highlighted.

Edit 2:

Examples

This is the actual format from my workbook:

Example 3

2
vbaexcelexcel-formulaexcel-2010
"...but I need to search for a whole array", what do you mean? If I put Gotham in F1, it correctly highlights any finding of Gotham in the range A1:D100 (it highlights "Gotham" and all text after in the cell). Are you saying that F1 could have, say Gotham, City, Wayne Enterprises, and you want to search for each one of those words (separated by a comma, or some other delimiter)? – BruceWayne
You're on the right track. You could make strTest a Collection and cycle through it for matches with a second For Loop. Since you're not using any UDTs, a collection would be easy to setup and loop through. – Tyeler
@BruceWayne I'm saying I'd want to search for Gotham, City, Wayne Enterprises. But they would all be in separate cells, not in a single cell separated by commas. I have a list of about 200 words, each in a different cell that I want to use as my search terms. – user6883405
Could you instead perhaps just use text to columns, using a comma delimiter, then just maybe use conditional formatting? Or do you need VBA? (You'd need to combine the red words together but it may be an alternative) – BruceWayne
I tried it originally, but because of the size of the data set and the range of items in each cell (some have 2 while some have 50), the text to column option started to get very messy and difficult to validate. – user6883405

2 Answers

2
votes

This is a method to achieve what you desire by looping through a range, collection, and array.

The code will find matches between the collection (your chosen match words) and the array (the string of words delimited in each cell). If a match is found, the starting and ending characters in the string are set and the characters between those values are colored.

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
1
votes

In keeping with your original code, you can just add another For each cell in Range (and a few other things):

Sub test4String2color()
Dim wb As Workbook
Dim ws As Worksheet

Dim strLen  As Integer
Dim i       As Long
Dim tst As Range

Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet

Dim keyWordRng As Range
Dim dataRng As Range
Set keyWordRng = ws.Range("F1:F2")
Set dataRng = ws.Range("A1:A5")

For Each tst In keyWordRng
    Debug.Print "Searching for: " & tst
    For Each cell In dataRng
        If tst.Value = cell.Value Then
            cell.Characters(InStr(cell, tst), strLen).Font.Color = vbRed
        ElseIf InStr(1, cell.Value, ",") > 0 Then
            getWordsInCell cell, tst.Value
        End If
    Next cell
Next tst
End Sub


Sub getWordsInCell(ByVal cel As Range, keyword As String)
Dim words() As String
Dim keywordS As Integer, keywordE As Integer
words = Split(cel.Value, ",")

Dim i As Long
For i = LBound(words) To UBound(words)
    Debug.Print "Found multiple words - one of them is: " & words(i)
    If Trim(words(i)) = keyword Then
        keywordS = ActiveWorkbook.WorksheetFunction.Search(keyword, cel, 1)
        keywordE = ActiveWorkbook.WorksheetFunction.Search(",", cel, keywordS)
        cel.Characters(keywordS, (keywordE - keywordS)).Font.Color = vbRed
    End If
Next i

End Sub

Please note I added to ranges (keyWordRng and dataRng) which you will need to tweak for your sheet. This should (fingers crossed) work!

enter image description here