Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Select Case Target.Column
Case 1, 2
Dim LLoop As Integer
Dim LTestLoop As Integer
Dim Lrows As Integer
Dim LRange As String
Dim LChangedValue As String
Dim LTestValue As String
'Test first 200 rows in spreadsheet for uniqueness
Lrows = 200
LLoop = 2
Dim sColChr$(1 To 2)
sColChr(1) = "A": sColChr(1) = "B"
'Check first 200 rows in spreadsheet
While LLoop <= Lrows
LChangedValue = sColChr(Target.Column) & CStr(LLoop)
If Not Intersect(Range(LChangedValue), Target) Is Nothing Then
If Len(Range(LChangedValue).Value) > 0 Then
'Test each value for uniqueness
LTestLoop = 2
While LTestLoop <= Lrows
If LLoop <> LTestLoop Then
LTestValue = sColChr(Target.Column) & CStr(LTestLoop)
'Value has been duplicated in another cell
If Range(LChangedValue).Value = Range(LTestValue).Value Then
'Set the background color to red
Range(LChangedValue).Interior.ColorIndex = 3
MsgBox Range(LChangedValue).Value & " already exists in cell " & sColChr(Target.Column) & LTestLoop
Exit Sub
Else
Range(LChangedValue).Interior.ColorIndex = xlNone
End If
End If
LTestLoop = LTestLoop + 1
Wend
End If
End If
LLoop = LLoop + 1
Wend
Case Else
' do nothing
End Select
End Sub |
