Comparing words in a cell to a fixed list of words

[Bill Roberts]

Greetings,

I have a spreadsheet with names and addresses. In the name column, I need to compare all the words to a fixed list of terms, such as "borrower", "homeowner", "LLC", etc. I will be highlighting the row to look at individually. So far, I can get the code to work, but with only one term, in this case: "BORROWER". I attempted to make an array with the list of words that would trigger highlighting the row, but that doesn't work. I get a type mismatch. Both versions of the code are here:

******************************************************************************************

Sub HighlightRenters()
Dim lastrow As Long, i As Integer, icount As Integer, sArray As Variant, noown As Variant


With ActiveSheet
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With

sArray = Array("BORROWER", "HOMEOWNER")


With ActiveSheet
For x = 1 To lastrow


If InStr(1, LCase(Range("F" & x)), "BORROWER", vbTextCompare) <> 0 Then


Rows(x).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With


' icount = icount + 1
' Range("H" & icount & ":L" & icount) = Range("A" & i & ":E" & i).Value
End If


Next x
End With


End Sub

***********************************************************************************

Okay that colors the rows with "Borrower" contained in the words in the F column.

Here is what I am trying using an array:


************************************************************************************

Sub HighlightRenters()
Dim lastrow As Long, i As Integer, icount As Integer, sArray As Variant, renter As Variant


With ActiveSheet
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With

sArray = Array("BORROWER", "HOMEOWNER","LLC")
renter = Split(sArray, ",")


With ActiveSheet
For x = 1 To lastrow




If InStr(1, LCase(Range("F" & x)), renter, vbTextCompare) <> 0 Then (This is the line with the type mismatch)


Rows(x).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With


Next x
End With


End Sub

**************************************************************************

Any advice will be appreciated.

Bill

 

[Eric W]

Welcome to the forum!

Consider this:

Sub HighlightRenters()
Dim lastrow As Long, x As Integer, icount As Integer, sArray As Variant, terms As String, word As Variant


    lastrow = Cells(Rows.Count, "B").End(xlUp).Row
    sArray = Array("BORROWER", "HOMEOWNER")


    For x = 1 To lastrow
        terms = Cells(x, "F").Value
        For Each word In sArray
            If InStr(1, terms, word, vbTextCompare) <> 0 Then
                Rows(x).Interior.Color = vbYellow
                Exit For
            End If
        Next word
    Next x


End Sub

To answer your main question, you need to loop through your array to check all of the words. You can't do it in one line. (Actually you really can with a complicated Evaluate statement, but let's keep it simple for now.) The "For Each word" loop looks at each word in your array, and the Instr checks each word against the value from column F.

I changed a few other things that may help. Accessing the sheet is slow, so that's why I saved the F value in "terms" instead of reading it multiple times from the sheet. Also, avoid .Select whenever possible, you can usually do the same thing by applying the method directly to the object. I removed the LCase, because when you use vbTextCompare, it ignores case anyway.

Hope this helps!

 

[Bill Roberts]

Greetings Cric,

Thanks so much. This worked perfectly. I am a hack at this macro thing... no training, just poking through the internet to "make it work."

Really appreciate your assistance.

Bill

 

[Eric W]

I'm a programmer by profession, by largely self-taught with VBA. So I know about poking through to "make it work". VBA is one of those languages that is easy to start with, but it's very deep, there's a lot to learn about it.

Glad I could help!