Hi,

am hoping someone out there can help me! I have one column of names, and I
want to identify within the next column everytime one of those names appears.
I can't just compare the columns though, because the names are embedded in
the second column.

i.e. Column A Column B
John Brown [Juliette Smith/Peter Smith/Brenda Jones]
Peter Smith [Adam Beechway/Trent Bandaly]
Carole Jones [Saby Sun\John Brown]

In this example, I want the John Brown and Peter Smith in Column B to be
highlighted. My list contains about 1500 rows, though Column B is slightly
shorter than Column A. Also, Column B does contain some blank cells.

Any help would be much appreciated!

Thanks
Emily

Hi Emily,

Try this macro out on a copy of your worksheet. It worked on the
example data you supplied.

It converts found names to bold.

Public Sub HighlightNames()
Application.ScreenUpdating = False
Dim lnLAtRowA As Long
Dim lnLastRowB As Long
Dim I As Long
Dim J As Long
lnlastrowA = _
ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
lnLastRowB = _
ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
For I = 1 To lnlastrowA
If Cells(I, 1) = "" Then GoTo BLANKA
For J = 1 To lnLastRowB
If Cells(J, 2) = "" Then GoTo BLANKB
On Error Resume Next
If Not (WorksheetFunction.IsError _
(WorksheetFunction.Find _
(Cells(I, 1).Value, Cells(J, 2)))) Then
Cells(J, 2).Characters _
(WorksheetFunction.Find _
(Cells(I, 1).Value, Cells(J, 2)), _
Len(Cells(I, 1).Value)).Font.Bold = True
End If
BLANKB: Next J
BLANKA: Next I
End Sub

Ken Johnson

Oops.

Last one had typo error (still worked though)

SHOULD HAVE BEEN...

Public Sub HighlightNames()
Application.ScreenUpdating = False
Dim lnLastRowA As Long
Dim lnLastRowB As Long
Dim I As Long
Dim J As Long
lnLastRowA = _
ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
lnLastRowB = _
ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
For I = 1 To lnLastRowA
If Cells(I, 1) = "" Then GoTo BLANKA
For J = 1 To lnLastRowB
If Cells(J, 2) = "" Then GoTo BLANKB
On Error Resume Next
If Not (WorksheetFunction.IsError _
(WorksheetFunction.Find _
(Cells(I, 1).Value, Cells(J, 2)))) Then
Cells(J, 2).Characters _
(WorksheetFunction.Find _
(Cells(I, 1).Value, Cells(J, 2)), _
Len(Cells(I, 1).Value)).Font.Bold = True
End If
BLANKB: Next J
BLANKA: Next I
End Sub

Ken Johnson

Just a note.

Instead of using worksheetfunction.find(), you could use VBA's own inStr().
Then you could check to see if that's = 0 (instead of using
worksheetfunction.iserror()).



Ken Johnson wrote:
>
> Oops.
>
> Last one had typo error (still worked though)
>
> SHOULD HAVE BEEN...
>
> Public Sub HighlightNames()
> Application.ScreenUpdating = False
> Dim lnLastRowA As Long
> Dim lnLastRowB As Long
> Dim I As Long
> Dim J As Long
> lnLastRowA = _
> ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
> lnLastRowB = _
> ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
> For I = 1 To lnLastRowA
> If Cells(I, 1) = "" Then GoTo BLANKA
> For J = 1 To lnLastRowB
> If Cells(J, 2) = "" Then GoTo BLANKB
> On Error Resume Next
> If Not (WorksheetFunction.IsError _
> (WorksheetFunction.Find _
> (Cells(I, 1).Value, Cells(J, 2)))) Then
> Cells(J, 2).Characters _
> (WorksheetFunction.Find _
> (Cells(I, 1).Value, Cells(J, 2)), _
> Len(Cells(I, 1).Value)).Font.Bold = True
> End If
> BLANKB: Next J
> BLANKA: Next I
> End Sub
>
> Ken Johnson

--

Dave Peterson

Using Dave's suggestion for improvement...

Public Sub HighlightNames()
Application.ScreenUpdating = False
Dim lnLastRowA As Long
Dim lnLastRowB As Long
Dim I As Long
Dim J As Long
Dim lnStartChar As Long
lnLastRowA = _
ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
lnLastRowB = _
ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
For I = 1 To lnLastRowA
If Cells(I, 1) = "" Then GoTo BLANKA
For J = 1 To lnLastRowB
If Cells(J, 2) = "" Then GoTo BLANKB
lnStartChar = InStr(Cells(J, 2).Value, Cells(I,
1).Value)
If lnStartChar <> 0 Then
Cells(J, 2).Characters _
(lnStartChar, Len(Cells(I,
1).Value)).Font.Bold = True
End If
BLANKB: Next J
BLANKA: Next I
End Sub

Thanks Dave.

Ken Johnson

Thanks Ken and Dave!

I tried the final Macro but was getting a syntax error. However, when I ran
your previous one, Ken, it worked! So many thanks both for your help. I still
can't believe how many people there are out there who are just happy to
assist!

Cheers,
Emily

"Ken Johnson" wrote:

> Using Dave's suggestion for improvement...
>
> Public Sub HighlightNames()
> Application.ScreenUpdating = False
> Dim lnLastRowA As Long
> Dim lnLastRowB As Long
> Dim I As Long
> Dim J As Long
> Dim lnStartChar As Long
> lnLastRowA = _
> ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
> lnLastRowB = _
> ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
> For I = 1 To lnLastRowA
> If Cells(I, 1) = "" Then GoTo BLANKA
> For J = 1 To lnLastRowB
> If Cells(J, 2) = "" Then GoTo BLANKB
> lnStartChar = InStr(Cells(J, 2).Value, Cells(I,
> 1).Value)
> If lnStartChar <> 0 Then
> Cells(J, 2).Characters _
> (lnStartChar, Len(Cells(I,
> 1).Value)).Font.Bold = True
> End If
> BLANKB: Next J
> BLANKA: Next I
> End Sub
>
> Thanks Dave.
>
> Ken Johnson
>
>

Hi Emily,
You're welcome.
The error was most likely due to the email producing an unwanted line
break.
Following should be OK, but I suppose it's all history now.

Public Sub HighlightNames()
Application.ScreenUpdating = False
Dim lnLastRowA As Long
Dim lnLastRowB As Long
Dim I As Long
Dim J As Long
Dim lnStartChar As Long
lnLastRowA = _
ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
lnLastRowB = _
ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
For I = 1 To lnLastRowA
If Cells(I, 1) = "" Then GoTo BLANKA
For J = 1 To lnLastRowB
If Cells(J, 2) = "" Then GoTo BLANKB
lnStartChar = InStr(Cells(J, 2).Value, _
Cells(I, 1).Value)
If lnStartChar <> 0 Then
Cells(J, 2).Characters(lnStartChar, _
Len(Cells(I, 1).Value)).Font.Bold = True
End If
BLANKB: Next J
BLANKA: Next I
End Sub

Ken Johnson