Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    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 = 1
    'Check first 200 rows in spreadsheet
    While LLoop <= Lrows
        LChangedValue = "A" & CStr(LLoop)
        If Not Intersect(Range(LChangedValue), Target) Is Nothing Then
            If Len(Range(LChangedValue).Value) > 0 Then
                'Test each value for uniqueness
                LTestLoop = 1
                While LTestLoop <= Lrows
                    If LLoop <> LTestLoop Then
                        LTestValue = "A" & 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 A" & 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
End Sub
 
 
No comments:
Post a Comment