---

MS Excel 2003: Create a column that must contain unique values

This Excel tutorial explains how to write a macro to create a column that must contain unique values in Excel 2003 and older versions (with screenshots and step-by-step instructions).

Question: I'm looking for tips which can help me in creating a data column (Alphanumeric) in Microsoft 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 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