Search code examples
vbaexcelstring-matchingconditional-formatting

Highlight strings in a cell in Excel based on a string in adjacent cell


I have a situation where I need to apply some conditional formatting to some comma-separated strings within a cell depending on whether their [A-Z] prefix does not match the [A-Z] prefix of the string in the adjacent cell. An example of the dataset I am working with is below:

  comma_separated_list           string_to_match
1 BND170015,BND170027,BNL160006  BND12000512
2 BOL030017,ISS160014,ISS160015  ISS03000325
3 BIL160182,BIL160185,BIL160186  BIL13001102
4 SRD160238,SRD160239,SRD160240  SRD12000987

For example in the first row, conditional formatting should only be applied to BNL160006 in the "comma_separated_list" column. This is because its alphabetical prefix, BNL, does not match the prefix of BND12000512 (in the "string_to_match" column). In row 2, conditional formatting should only be applied to BOL030017 (because it doesn't match ISS03000325). And so on.

As a start, I began by putting something together that would highlight any prefix in the left hand column that appears in the right-hand one. However, this wasn't precisely what I needed; it only highlighted the prefix (not the whole string), and I also want it to highlight only the non-matching strings.

Sub ColourText()
    Dim xStr As String
    Dim xRg As Range
    Dim xCell As Range
    Dim xChar As String
    Dim I As Long
    Dim J As Long

    Set xRg = Range("B2:C10000")
    If xRg Is Nothing Then Exit Sub
    For I = 0 To xRg.Rows.Count - 1
        xStr = Left(xRg.Range("B1").Offset(I, 0).Value, 3)
        With xRg.Range("A1").Offset(I, 0)
            .Font.ColorIndex = 1
            For J = 1 To Len(.Text)
                If Mid(.Text, J, Len(xStr)) = xStr Then .Characters(J, Len(xStr)).Font.ColorIndex = 3
            Next
        End With
    Next I
End Sub

I also looked into doing it all through formulae, but I couldn't see a way of doing this and applying conditional formatting at the same time. So I'm a bit stuck at the moment. Would be very grateful for some help.


Solution

  • Try something like this...

    The code assumes that the strings are placed in column A and strings to match with are placed in column B. Modify it as per your requirement.

    Sub HighlightUnMatchedText()
    Dim lr As Long, i As Long, Pos As Long
    Dim Rng As Range, Cell As Range
    Dim str() As String, critStr As String
    Application.ScreenUpdating = False
    lr = ActiveSheet.UsedRange.Rows.Count
    Set Rng = Range("A2:A" & lr)
    Rng.Font.ColorIndex = xlAutomatic
    For Each Cell In Rng
        If Cell <> "" And Cell.Offset(0, 1) <> "" Then
            critStr = Left(Cell.Offset(0, 1), 3)
            str() = Split(Cell.Value, ",")
            For i = 0 To UBound(str)
                If Left(VBA.Trim(str(i)), 3) <> critStr Then
                    Pos = InStr(Cell.Value, str(i))
                    Cell.Characters(Pos, Len(str(i))).Font.Color = vbRed
                End If
            Next i
        End If
    Next Cell
    Application.ScreenUpdating = True
    End Sub