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.
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