Highlight duplicate cells based on a selected cell

[igbert]

Is there a formula to highlight all duplicate cells from a selected cell?

Cell A1 aaa
Cell A2 bbb
Cell A3 8888
Cell A4 bbb
Cell A5 bbb
Cell A6 8888
Cell A7 8888

When I select bbb in Cell A2, I want the font in Cell A2, A4 and A5
highlighted. Likewise, if I select ccc in Cell A3, I want the font in Cell
A3, A6, A7 hightlighted.

 

[Mike H]

Hi,

Right click your sheet tab, view code and paste this in and try selecting
cells in Column A


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 1 Then
Columns(1).Interior.ColorIndex = xlNone
Exit Sub
End If
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Set myrange = Range("A1:A" & Lastrow)
For Each c In myrange
If c.Value = Target.Value Then
c.Interior.ColorIndex = 7
Else
c.Interior.ColorIndex = xlNone
End If
Next
End Sub

Mike

 

[Mike H]

slight change

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
If Target.Column <> 1 Or Target.Row > Lastrow Then
Columns(1).Interior.ColorIndex = xlNone
Exit Sub
End If

Set myrange = Range("A1:A" & Lastrow)
For Each c In myrange
If c.Value = Target.Value Then
c.Interior.ColorIndex = 7
Else
c.Interior.ColorIndex = xlNone
End If
Next
End Sub

Mike

 

[igbert]

Hi Mike.

It works perfectly. Many thanks.

How does it work if If I also want to highlight another column in the same
workhsheet?

How does if work if I also want to highlight the range for the selected cell
A2? i.e. hightlight from Cell A2 to D2, A4 to D4, A5 to D5.

Column A B C D
1 aaa 224 471 773
2 bbb 555 632 444
3 8888 145 678 987
4 bbb 414 565 232
5 bbb 478 821 953
6 8888 231 599 636
7 8888 323 999 636

the highlight to apply to an

 

[Ken Christman]

This code is what I need but how would it be modified to highlight any dups. in Col A that also show up in Col Q too.



Mike wrote:

slight changePrivate Sub Worksheet_SelectionChange(ByVal Target As
27-Mar-09

slight change

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
If Target.Column <> 1 Or Target.Row > Lastrow Then
Columns(1).Interior.ColorIndex = xlNone
Exit Sub
End If

Set myrange = Range("A1:A" & Lastrow)
For Each c In myrange
If c.Value = Target.Value Then
c.Interior.ColorIndex = 7
Else
c.Interior.ColorIndex = xlNone
End If
Next
End Sub

Mike

:

Previous Posts In This Thread:

Highlight duplicate cells based on a selected cell
Is there a formula to highlight all duplicate cells from a selected cell?

Cell A1 aaa
Cell A2 bbb
Cell A3 8888
Cell A4 bbb
Cell A5 bbb
Cell A6 8888
Cell A7 8888

When I select bbb in Cell A2, I want the font in Cell A2, A4 and A5
highlighted. Likewise, if I select ccc in Cell A3, I want the font in Cell
A3, A6, A7 hightlighted.

Hi,Right click your sheet tab, view code and paste this in and try selecting
Hi,

Right click your sheet tab, view code and paste this in and try selecting
cells in Column A


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 1 Then
Columns(1).Interior.ColorIndex = xlNone
Exit Sub
End If
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Set myrange = Range("A1:A" & Lastrow)
For Each c In myrange
If c.Value = Target.Value Then
c.Interior.ColorIndex = 7
Else
c.Interior.ColorIndex = xlNone
End If
Next
End Sub

Mike

:

slight changePrivate Sub Worksheet_SelectionChange(ByVal Target As
slight change

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
If Target.Column <> 1 Or Target.Row > Lastrow Then
Columns(1).Interior.ColorIndex = xlNone
Exit Sub
End If

Set myrange = Range("A1:A" & Lastrow)
For Each c In myrange
If c.Value = Target.Value Then
c.Interior.ColorIndex = 7
Else
c.Interior.ColorIndex = xlNone
End If
Next
End Sub

Mike

:


Submitted via EggHeadCafe - Software Developer Portal of Choice
BizTalk Repeating Structures Table Looping and Table Extract
http://www.eggheadcafe.com/tutorial...0-a5704fe31a76/biztalk-repeating-structu.aspx

 

[Bob Phillips]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
If Target.Column <> 1 Or Target.Row > LastRow Then
Columns(1).Interior.ColorIndex = xlNone
Exit Sub
ElseIf Not IsError(Application.Match(Target.Value, Me.Columns("Q"), 0))
Then
Columns(1).Interior.ColorIndex = xlNone
Exit Sub
End If
End Sub