Excel: Create a column that must contain unique values in Excel 2003/XP/2000/97

Question: I'm looking for tips which can help me in creating a data column (Alphanumeric) in Excel 2003/XP/2000/97 where each row has to hold unique data. If a user enters a duplicate value in the column, the spreadsheet should not accept this value.

Answer: There are several "events" available within an Excel spreadsheet where you can place VBA code. In your case, we want to check for a duplicate value when the "Worksheet_Change" event fires.

Let's take a look at an example.

Download Excel spreadsheet (as demonstrated below)

In our spreadsheet, we've set up column A in Sheet1 to contain unique values. On this sheet, we've placed code on the "Worksheet_Change" event, so that whenever a value is entered in column A (within the first 200 rows), the macro will test to see if this value has been entered before.

If the value is a duplicate, the following message will appear:

And the background color of the cell that contains the duplication will turn red.

In this example, we've entered the value 1234 in cell A5 which already exists in cell A2.

You can press Alt-F11 to view the VBA code.

Macro Code:

The macro code looks like this:

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 = 2

    '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 = 2
                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