Comparing data from one column with data within another column

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

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()).
 
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
 
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
 
Back
Top