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.
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