If cell contains partial match of multiple text strings, then apply conditional formatting VBA

Question

Currently able to do a VBA search on a column range like H:H and apply conditional formatting if any cells in H:H has a partial match against cell A1, which might be "LTD". However, i'm struggling to find a code that allows me to expand partial matches to cell B1 "CO" and C1 "LLC" against H:H. Ideally I want to look at multiple cells against H:H with one code, rather than having to run the code multiple times to get the conditional formatting.

The VBA code is below:

Private Sub CommandButton1_Click()
 
Dim Partial_Text As String
Dim myrange As Range

Partial_Text = Worksheets("Workbook").Cells(1, 1).Value
Set myrange = Worksheets("Workbook").Range("H:H")
myrange.Interior.Pattern = xlNone

For Each cell In myrange

    If InStr(LCase(cell.Value), LCase(Partial_Text)) <> 0 Then cell.Interior.ColorIndex = 4
 
Next

End Sub

Is anyone able to help me and improve on this?

Thank you!

Tried the code above and would like a solution that allows me to run the VBA code once, as opposed to multiple times. The reason I ran VBA code, is because in standard excel formulas wildcards aren't picking up the partial matches, but VBA does.

This is easily accomplished with `SEARCH` and `ISNUMBER` worksheet formulas, btw. — BigBen, Aug 09 '23 at 17:45

score 1 · Answer 1 · answered Aug 09 '23 at 17:53

Something like this maybe:

Private Sub CommandButton1_Click()
 
    Dim cell As Range, ws As Worksheet
    Dim myrange As Range, v, arrTerms As Variant, r As Long
    
    Set ws = Worksheets("Workbook")
    Set myrange = ws.Range("H1:H" & ws.Cells(Rows.Count, "H").End(xlUp).row)
    myrange.Interior.Pattern = xlNone
    
    arrTerms = ws.Range("A1:C1").Value 'for example: all search terms
    
    For Each cell In myrange.Cells
        v = cell.Value
        If Len(v) > 0 Then
            For r = 1 To UBound(arrTerms, 1) 'loop array of search terms
                If InStr(1, v, arrTerms(r, 1), vbTextCompare) <> 0 Then
                    cell.Interior.ColorIndex = 4
                    Exit For 'no need to check further
                End If
            Next r
        End If  'anything to check
    Next        'cell to check

End Sub

score 0 · Answer 2 · answered Aug 09 '23 at 17:48

Try to modify the code as follows:

Private Sub CommandButton1_Click()
    Dim Partial_Text As Variant
    Dim myrange As Range
    Dim keywords As Variant
    Dim keyword As Variant

    ' Define the partial match keywords in an array
    keywords = Array("LTD", "CO", "LLC")

    Set myrange = Worksheets("Workbook").Range("H:H")
    myrange.Interior.Pattern = xlNone

    For Each cell In myrange
        For Each keyword In keywords
            Partial_Text = Worksheets("Workbook").Cells(1, keyword).Value
            If InStr(LCase(cell.Value), LCase(Partial_Text)) <> 0 Then
                cell.Interior.ColorIndex = 4
                Exit For ' Exit the loop if a match is found for this keyword
            End If
        Next keyword
    Next cell
End Sub

I hope it works! :)

If cell contains partial match of multiple text strings, then apply conditional formatting VBA

2 Answers2