Solved: Unique Defined Named Range and Validation List

[MDY]

Hi,
Ive been searching and trying to work this one out all day but havent found a solution as yet. I have a named range with about 1000 lines so B4:b1004 which contains the data I would like to return in a validated list. In this list I only want to return the unique records no duplicates and sorted alphabetically. I want the list to work from the live data itself without being filtered. I'm sorry but I cant work out for the life of me how this can be done. i did find this explanation on the net but could not get it to work properly.

Step one Create module:
[vba]Public Function Asset( _
ByVal SourceValues As Range) As Variant
Dim Items As New Collection
Dim Row As Long
Dim Result As Variant

On Error Resume Next
For Row = 1 To SourceValues.Rows.Count
Items.Add SourceValues(Row), SourceValues(Row)
Next Row
On Error GoTo 0
ReDim Result(1 To Application.Caller.Rows.Count)
For Row = 1 To Application.Caller.Rows.Count
Result(Row) = ""
Next Row
For Row = 1 To Application.Min(Items.Count, Application.Caller.Rows.Count)
Result(Row) = Items(Row)
Next Row
UniqueValues = Application.Transpose(Result)
End Function[/vba]

Step 2 Define and Name List "Asset"

Step 3 Validation, List, source F3, select "Asset"

If anyone has a soloution or an idea of how this could work that would be great.

Thanks

MDY

[david000]

http://www.vbaexpress.com/forum/showthread.php?t=24229

Oh, this thread is close.

[GTO]

Greetings MDY,

I believe I followed Mike's example, in which case credits to mikerickson's example at the link David provided above. Of course if it doesn't work, it would be my glitch...

Anyways, in a copy of your wb try:

[VBA]Sub AddUniquesAndSort()
Dim myRange As Range
Dim rCell As Range
Dim myColl As Collection
Dim i As Long
Set myColl = New Collection

myColl.Add Item:="DUMMY", Key:="DUMMY"

Set myRange = Range("B4:B1004")

On Error Resume Next
For Each rCell In myRange
If Not rCell.Value = vbNullString Then
For i = 1 To myColl.Count
If rCell.Value < myColl(i) Then
myColl.Add Item:=rCell.Value, Key:=CStr(rCell.Value), before:=i
End If
Next
myColl.Add Item:=rCell.Value, Key:=CStr(rCell.Value)
End If
Next rCell
On Error GoTo 0

myColl.Remove "DUMMY"

myRange.ClearContents

Set myRange = myRange.Resize(myColl.Count)

i = 0
For Each rCell In myRange
i = i + 1
rCell.Value = myColl(i)
Next

End Sub[/VBA]

Hope this helps,

Mark

[MDY]

.

[MDY]

Hi David and GTO,
Thanks providing some help with this one. I understand taht I need to put the code in as a module but I'm not sure how I then relate this back to a validated field which I am calling "asset".

Could you possibly provide some direction on this.

Thanks!
MDY

[GTO]

Hi MDY,

I'm afraid you lost me on that last part. Could you attach a copy of the wb, with any company/private info redacted and some fake data? Maybe that would help me see what you mean.

Mark

[MDY]

Hi Mark,
Sorry I got you a bit lost in the last post. Please find attached a WB with a bit more explantion.

Thanks

Mdy

[GTO]

Hi MDY,

I looked at the workbook, and indeed, it made it easier to "see" what you were trying to relay.

The Sub is still mostly the same, though you'll see that I changed the range name (mostly just whim, but was thinking of a possibility), as well as included/added a way of finding the last used row.

I added a temp sub to easily reset the primary input just to make it easier to test/see.

Also - while you did have a Name to grab the list from another sheet, I changed this a bit. While it doesn't seem like it would be hard to define the name thru code (ea time the unique/sort procedure is run) I figured hard-coding the name would be okay, as long as more than enough rows are included.

In short - rather than referring to a static range, the Name now refers to a dynamic range, by using:

=OFFSET('Validation field data'!$A$2,0,0,COUNTA('Validation field data'!$A$2:$A$1001),1)

Thus, the drop-downs on the first sheet should not have a bunch of blanks in the drop-down list after reducing the range to just the unique names/values.

NOTE: One thing that piqued my curiosity was whether after assigning a particular value from the drop-down, do you still want the value to be in the drop-down? In other words, normally any particular item from a DV list can be assigned multiple times. As you are already interested in only unique values, are these values then allowed to be assigned multiple times, or, only once per unique value?

Hope this helps,

Mark

[MDY]

Hi Mark,
The final solution is correct for what I am after but I was hoping that this could be done just from the one list C:C and without having to actualy run any macros or anything to update the unique fields in the validation drop down list. The validation fields can be assigned to the cell mutiple times accross the range.

Thanks for your efforts on this one so far mate.

Cheers
Mdy

[Krishna Kumar]

Hi,

on sheet 'validation field' module

[vba]Private Sub Worksheet_Activate()
Dim ws As Worksheet, lRow As Long
Set ws = Sheets("Validation field data")
lRow = ws.Range("c" & Rows.Count).End(xlUp).Row

With ws
.Columns(1).Clear
.Range("c1:c" & lRow).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ws.Cells(1, 1), Unique:=True
With .Range("a1", .Range("a" & Rows.Count).End(xlUp))
.Sort Key1:=ws.Cells(2, 1), Order1:=xlAscending, Header:=xlYes
.Offset(1).Resize(.Rows.Count - 1).Name = "Asset" 'change to suit
End With
End With
End Sub[/vba]

HTH

[MDY]

Hi,
thanks for both your replys HTH and Mark but I still have the same problem. Each of these codes pastes a unique list into another range. For the solution i dont want to have to use other lists etc etc but for the validation field to simply work off column C:C and produce a unique validation list. the problem is that the sheet that this data is coming off contains data in all the columns not just C:C so there is no room to paste another unique list reading of C:C and why I just need it to create a unique validation list straight from C:C. Is this possible?

Thanks
MDY

[GTO]

Mdy,

Each of these codes pastes a unique list into another range.

Whoa hoss, let's take a step back. The values I placed in Col C have nothing to due with the unique/sorted list in Col A. The values in C were for the temp sub I referred to for ease of testing/demo only.

You can delete the sub:

[vba]Sub ResetVals()
shtValidationdata.Range("A2:A30").Value = shtValidationdata.Range("C2:C30").Value

End Sub[/vba]

...as well as the values in Col C and the macro runs fine.


[vba]Sub AddUniquesAndSort()
Dim rngData As Range
Dim rCell As Range
Dim myColl As Collection
Dim i As Long
Dim lngLastRow As Long

Set myColl = New Collection

myColl.Add Item:="DUMMY", Key:="DUMMY"
lngLastRow = shtValidationdata.Cells(Rows.Count, 1).End(xlUp).Row

Set rngData = shtValidationdata.Range("A2:A" & lngLastRow)

On Error Resume Next
For Each rCell In rngData
If Not rCell.Value = vbNullString Then
For i = 1 To myColl.Count
If rCell.Value < myColl(i) Then
myColl.Add Item:=rCell.Value, Key:=CStr(rCell.Value), before:=i
End If
Next
myColl.Add Item:=rCell.Value, Key:=CStr(rCell.Value)
End If
Next rCell
On Error GoTo 0

myColl.Remove "DUMMY"

rngData.ClearContents

Set rngData = rngData.Resize(myColl.Count)

i = 0
For Each rCell In rngData
i = i + 1
rCell.Value = myColl(i)
Next
End Sub[/vba]

While it currently runs in Col A, this can easily be changed to Col C or wherever you want it - just remember to rewrite the formula for the Name.

I would mention that in your first post, you stated B4:B1004. In the example you attached, Col A is indicated. Now you want Col C. In the kindest way, please stick with a pick.

Reference changing it to C:C, for the code, just change to:
lngLastRow = shtValidationdata.Cells(Rows.Count, 3).End(xlUp).Row
Set rngData = shtValidationdata.Range("C1:C" & lngLastRow)

...and I believe (did not test) change the formula the name refers to, to:

=OFFSET('Validation field data'!$C$1,0,0,COUNTA('Validation field data'!$C$1:$C$65535),1)

Please note that I discluded the last row (for pre 2007) in the formula, as I do not know if COUNTA will take a whole column.

Hope this helps,

Mark

[MDY]

Hi Mark,
Thanks for providing this solution, you've really helped me out of a jam.

Cheers
Mdy