0

I want to Highlight the value from coloumn B in Coloumn A. Note : Column B contains the subset of text in Column A.

Example : enter image description here

3
  • in your example you show all filled cells in a and b highlighted. What cell do you want highlighted A or B?
    – Brino
    Jun 3, 2015 at 14:18
  • Sorry My bad,I want to highlight Column A Jun 3, 2015 at 14:20
  • Please update your picture to show which cells should be highlighted. Specifically, is it checking if the subset is in the cell next to it (i.e. same row) or is it checking if any of the values in B contain a subset?
    – Byron Wall
    Jun 3, 2015 at 16:19

3 Answers 3

1

The best I could come up with was using VBA to change the color of the font.

Dim row As Integer
Dim str As String
Dim index As Integer
Dim rng As Range

lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).row

Set rng = Range("A1")

For row = 1 To lastRow
    str = rng.Offset(0, 1).Value
    index = InStr(rng.Value, str)
    If index > 0 Then rng.Characters(index).Font.Color = vbGreen
    Set rng = rng.Offset(1, 0)
Next row

Set rng = Nothing
0
0

Using the dictionary method and highlight if the key found in the dictionary
Highlighted Result

Option Explicit

Sub HiglightColumn()

Dim MyWorkbook As Workbook
Dim MyWorksheet As Worksheet
Set MyWorkbook = Workbooks(ActiveWorkbook.Name)
Set MyWorksheet = MyWorkbook.Sheets("WorksheetName")

Dim LastRow As Long
Dim CurrentRow As Long
Dim myList As Object
Set myList = CreateObject("Scripting.Dictionary")

For CurrentRow = 2 To MyWorksheet.Cells(MyWorksheet.Rows.Count, "B").End(xlUp).row
myList.Item(Right(MyWorksheet.Range("B" & CurrentRow), 6)) = "new"
Next

For CurrentRow = 2 To MyWorksheet.Cells(MyWorksheet.Rows.Count, "A").End(xlUp).row
    If myList.Exists(Right(MyWorksheet.Range("A" & CurrentRow), 6)) Then
        With MyWorksheet.Range("A" & CurrentRow).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 5287936
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        Else
            With MyWorksheet.Range("A" & CurrentRow).Interior
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
     End If
Next CurrentRow

End Sub
1
  • This assumes the "string" to be found is always 6 characters long and at the end of the text in column A
    – EEM
    Jun 6, 2015 at 0:10
0

This procedure highlights cells in Column A and "bolds" (better word?) the string found (see comments in the code)

Option Explicit

Sub FindMatchAndMark_Interior()
Dim WshTrg As Worksheet
Dim lLastRowA As Long, lLastRowB As Long
Dim lRowA As Long, lRowB As Long
Dim sCllB As String
Dim bPos As Byte

    Rem Set Target Worksheet - Update as needed
    Set WshTrg = ActiveSheet

    With WshTrg
        lLastRowA = fLRng_LastRow_byCol_Find(.Columns(1))
        lLastRowB = fLRng_LastRow_byCol_Find(.Columns(2))

        Rem To Clear Prior Results
        Range(.Cells(1, 1), .Cells(lLastRowA, 1)).Font.Bold = False
        With Range(.Cells(1, 1), .Cells(lLastRowA, 1)).Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With

        Rem Starting from Row 2 - Update as needed
        For lRowA = 2 To lLastRowA
            For lRowB = 2 To lLastRowB
                sCllB = .Cells(lRowB, 2).Value2
                bPos = InStr(.Cells(lRowA, 1).Value2, sCllB)
                If bPos > 0 Then
                    Rem Fill Interior and Bold String Found
                    With .Cells(lRowA, 1)
                        .Characters(Start:=bPos, Length:=Len(sCllB)).Font.Bold = 1
                        .Interior.Color = RGB(155, 194, 230)
                    End With
                    Exit For
    End If: Next: Next: End With
End Sub

Function fLRng_LastRow_byCol_Find(ColTrg As Range) As Long
    On Error Resume Next
    fLRng_LastRow_byCol_Find = ColTrg.Find(What:="*", _
        After:=ColTrg.Cells(1), LookIn:=xlFormulas, LookAt:=xlPart, _
        SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
        MatchCase:=False, SearchFormat:=False).row
    On Error GoTo 0
End Function

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.