ExcelBanter - Creating a ratings list in Excel

Dennis,

This assumes your ratings are in the range B1:B10 - change as necessary. If
somebody enters a duplicate value in that range it erases the previous
occurence of the value. It checks for entering into more than one cell at a
time.

Paste this code into the code module for the worksheet - right-click the
sheet tab and choose View Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim target_cell As Range, cell As Range, ratings As Range

Set ratings = Range("B1:B10")
On Error GoTo err_handler
Application.EnableEvents = False
If Not Intersect(Target, ratings) Is Nothing Then
For Each target_cell In Target
For Each cell In ratings
If cell.Address < target_cell.Address And _
cell.Value = target_cell.Value And _
Not Intersect(target_cell, ratings) Is Nothing Then
cell.ClearContents
End If
Next cell
Next target_cell
End If

err_handler:
Application.EnableEvents = True

End Sub

hth,

Doug Glancy

"Dennis Gaucher" wrote in message
...

I'm trying to create a list where users could rate their preferences on
a 1-10 scale.
For example, column A might contain apples, pears, oranges, bananas.etc.
In column B, user would assign preference on a numerical scale. Column
B should not contain duplicate values, i.e. there should be only a
single "1" or "2". Perhaps a message box to flag duplicates?

*** Sent via Devdex http://www.devdex.com ***
Don't just participate in USENET...get rewarded for it!