Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

Validate cell with a list of non repeating value 1

Status
Not open for further replies.

rodesh

Computer
Jan 21, 2004
3
0
0
CA
I have a column list containing e.g.
Sunday
Sunday
Monday
Monday
Monday
Tuesday
....
...

Now I want to validate cell which shows list e.g.
Sunday
Monday
Tuesday
..
..
Without repeating values.
 
Replies continue below

Recommended for you

Just brainstorming here, but maybe something like this will work....

1) Create a list of acceptable values
2) Name the range (select all of the values, then Insert-Name->Define, give a name)
3) Turn on Validation (Tools->Validation->List and point to the list created in step 1.
4) Write a small snippet of code that will HIDE the row that contains the item selected in list 1.

For example, on sheet 2, you can create a list with the days of the week..... A1 = Sunday, A2 = Monday, ..... On Sheet 1, select column A and turn on the validation (as described in step 3 above where the list is the name of the range that you defined in step 2). Then whenever you select a cell in sheet 1 column A, you will always be forced to select a value from sheet 2 column A. If you create a macro to simply hide the row (in sheet 2), then the value should not appear in the selection on sheet 1.

Just a thought, hope this helps!
 
After tinkering with it for a few minutes, simply hiding the row does not remove it from the validation list. Therefore, you're code will have to remove the value from the named list. If you really want to get tricky, you can create another list with all of the used values, and you can keep track of all of the used values. This would be helpful if you ever plan on reinsertng a used value into your selection list (say if the user accidently chose the wrong day and selects another).
 
Thanks Melone and Prex
I want to make non repeating validation list directly from original list without intermediate column of list. It will better if it could me made by custom function in VBA.

rodesh
 
You want to use data validation:

option:
custom list

enter the following formula:

=NOT(OR(COUNTIF($A$1:$A$100,A6)>1))

This will not let you duplicate entries from .
Now go to the error box and type want you want for a pop up.
hope this helps,

-mechantaeus

----------------------------------------
Work Hard and Work Smart.
 
I've hit this problem before, and solved it with VBA.

The following VBA custom function will take a list of values containing (possibly) repeated entries, and create from it a sorted list that does not contain any repeats.

FWIW & HTH

- - - - - - VBA Code begins - - - - - -
[tt]
Option Base 1
Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function Remove_Dups(In_List As Range)
'
' Takes as input a column of values.
'
' Creates from these values a sorted list without duplicates, which
' is returned to the calling spreadsheet as an array variable.
'
Dim InRows As Long, InCols As Long, OutRows As Long, OutCols As Long
Dim I As Long, J As Long, NumEntries As Long
Dim ErrText As String
Dim Ans() As Variant, SortedList() As Variant
Const FnName As String = "Function Remove_Dups"
Const EmptyMark As String = "-"
'
' Get the sizes of the input range and the output range.
'
InRows = In_List.Rows.Count
InCols = In_List.Columns.Count
OutRows = Application.Caller.Rows.Count
OutCols = Application.Caller.Columns.Count
'
' We now know the required sizes for several VBA arrays, so
' declare them accordingly.
'
ReDim Ans(OutRows, OutCols)
ReDim SortedList(OutRows, 1)
'
' Apply a few checks to these array sizes before going any further.
'
If InCols <> 1 Or OutCols <> 1 Or InRows < 2 Or OutRows < InRows Then
ErrText = "Problem with sizes of input or output ranges."
GoTo ErrorReturn
End If
'
' Create a VBA array containing the entries to be processed.
' Skip over empty cells, and also skip cells containing
' the "EmptyMark".
'
' (The EmptyMark bit can be changed or dropped as required.)
'
NumEntries = 0
For I = 1 To InRows
If Not IsEmpty(In_List(I, 1)) And In_List(I, 1) <> EmptyMark Then
NumEntries = NumEntries + 1
SortedList(NumEntries, 1) = In_List(I, 1)
End If
Next I
'
' If the input range contains no valid entries, go gentle into the night.
'
If NumEntries < 1 Then
For I = 1 To OutRows
Ans(I, 1) = EmptyMark ' Could use "" here instead.
Next I
Remove_Dups = Ans
Exit Function
End If
'
' Sort the array.
' Do this using some code filched from the Internet and used in
' heaps of other places. It appears below, as part of this module.
'
Call QuickSort(SortedList, 1, 1, NumEntries)
'
' Scan through the sorted array, grabbing the first instance of
' each unique entry as we go, and putting it into the output array.
'
J = 1
Ans(1, 1) = SortedList(1, 1)
For I = 2 To NumEntries
If SortedList(I, 1) <> SortedList(I - 1, 1) Then
J = J + 1
Ans(J, 1) = SortedList(I, 1)
End If
Next I
'
' Fill the remainder of the output array with "Emptymark".
'
If J < OutRows Then
For I = J + 1 To OutRows
Ans(I, 1) = EmptyMark
Next I
End If
'
' It's all over, Red Rover.
'
Remove_Dups = Ans
Exit Function
'
' Error handling area.
'
ErrorReturn:
For I = 1 To OutRows
Ans(I, 1) = CVErr(xlErrNA) ' Fill output cells with "#N/A"
Next I
MsgBox ErrText, , FnName
Remove_Dups = Ans
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub QuickSort(SortArray, col, L, R)
'
' Performs a "quicksort" on a two-dimensional array.
' SortArray - The two-dimensional array to be sorted.
' col - The (single) column number containing the sort key.
' L - The first row number of the band to be sorted.
' R - The last row number of the band to be sorted.
'
' Always sorts in ASCENDING order.
'
' Grabbed off Google Groups by me in June 2004.
'
' Originally Posted by Jim Rech 10/20/98 Excel.Programming
' Modified to sort on first column of a two dimensional array.
' Modified to handle a sort column other than 1 (or zero).
'
Dim I As Long, J As Long, mm As Long
Dim X As Variant, Y As Variant
'
' Set new extremes to old extremes.
' Get sort key for row in middle of new extremes.
'
I = L
J = R
X = SortArray((L + R) / 2, col)
'
' Loop for all rows between the extremes.
'
While (I <= J)
'
' Find the first row whose key is greater than that of the middle row.
'
While (SortArray(I, col) < X And I < R)
I = I + 1
Wend
'
' Find the last row whose key is less than that of the middle row.
'
While (X < SortArray(J, col) And J > L)
J = J - 1
Wend
'
' If the new "greater" row is smaller than the new "lesser" row
' swap them, then advance the pointers to the next rows.
'
If (I <= J) Then
For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
Y = SortArray(I, mm)
SortArray(I, mm) = SortArray(J, mm)
SortArray(J, mm) = Y
Next mm
I = I + 1
J = J - 1
End If
Wend
'
' Recurse to sort the lower then the upper halves of the extremes.
'
If (L < J) Then Call QuickSort(SortArray, col, L, J)
If (I < R) Then Call QuickSort(SortArray, col, I, R)
'
End Sub
[/tt]
- - - - - - VBA code ends - - - - - -
 
Status
Not open for further replies.
Back
Top