Duplicates

  • Thread starter Thread starter Stevie
  • Start date Start date
S

Stevie

Hi Guys,

Any ideas how I can adapt this code so that when a duplicate is found
and I press a certain key, the duplicated entries found are shaded a
different colour and are then kept that colour ?

Thanks.

Stevie.

*****************************************************************************


Here is one way

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const myRange As String = "A1:E60"
If Target.Count = 1 Then
If Not Intersect(Target, Range(myRange)) Is Nothing Then
With Range(myRange)
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, _
Formula1:="=" & Target.Address &
"=" &
Target.Address(False, False)
.FormatConditions(1).Interior.ColorIndex = 3
End With
End If
End If
End Sub

'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click on the sheet tab, select
'the View Code option from the menu, and paste the code in.


--

HTH

RP
(remove nothere from the email address if mailing direct)
 
Stevie,

I originally used conditional formatting, and removed aftre moving on. This
way will use the same method on the cell select to identify the duplicates,
if you double-click on any of the highlighted cells, it will then set the
cell's colour to a slightly different hue.


Private Const myRange As String = "A1:E60"

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 Then
If Not Intersect(Target, Range(myRange)) Is Nothing Then
With Range(myRange)
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, _
Formula1:="=" & Target.Address & "=" &
Target.Address(False, False)
.FormatConditions(1).Interior.ColorIndex = 3
End With
End If
End If
End Sub


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Dim cell As Range
If Target.Count = 1 Then
If Not Intersect(Target, Range(myRange)) Is Nothing Then
With Range(myRange)
For Each cell In Range(myRange)
If cell.Value = Target.Value Then
cell.Interior.ColorIndex = 7
End If
Next cell
End With
Target.Offset(0, 1).Activate
End If
End If
End Sub
 
Back
Top