Unique Value List in VBA

[pezalmendra]

Hello,

One doubt I have about creating a List with validation data:

It is possible to create a List in a certain cell with unique values from a range but without creating for that an extra list with formulas in another range of the workbook?
All that I have seen by this moment is that they create from the original list where all the data is a new list with match formulas to have by separate this unique values. And then, they create a validation data list with that info...

Regards,

[TMS]

If you're already using VBA, you could use Collection or Dictionary to create a list of unique entries and then create a comma separated text string to pass to the Data Validation list.

Regards, TMS

[pezalmendra]

Hello!!

Thanks for the idea! I am trying to create this Collection but I am a bit stucked on this...

This is the code I have created, I would like to have the validation list in cell "Q6" but cannot manage it.

Sub UniqueValueList()
    Dim cUnique As Collection
    Dim Rng As Range
    Dim Cell As Range
    Dim sh As Worksheet
    Dim vNum As Variant
   
    Set sh = ThisWorkbook.Sheets("Survey")
    Set Rng = sh.Range("M12", sh.Range("M12").End(xlDown))
    Set cUnique = New Collection
   
    On Error Resume Next
        For Each Cell In Rng.Cells
            cUnique.Add Cell.Value, CStr(Cell.Value)
        Next Cell
    On Error GoTo 0
   
    For Each vNum In cUnique
        sh.Range("Q6") = vNum
    Next vNum
End Sub

Any help would be much appreciated. Thanks

Regards

[TMS]

I actually used a Dictionary when I did it, based on code I found elsewhere. This is a cut down version of the code:

It is passed the range where the data is present and the cell where the Data Validation List is required.

' Generic Worksheet Selection Change subroutine
Sub WSC_x( _
            ByVal rRawData As Variant, _
            ByVal sDVOut As Variant)

' Worksheet Selection Change processing routine
' This routine creates the Primary DD DV List

Dim awf As WorksheetFunction: Set awf = WorksheetFunction
Dim InputList               ' Input Array
Dim SDVString As String     ' data Validation output string

sTMSDebug "WSC_x", rRawData.Address, sDVOut

' store the range in an array
InputList = _
    awf.Transpose(rRawData)
   
' sort the array
' uses default parameters
' all entries ascending
' QSortInPlace InputList <<< from Chip Pearson's site
   
' create a "dictionary" of the DV data
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")

Dim i As Long
For i = LBound(InputList) To UBound(InputList)
    d(InputList(i)) = 1
Next 'i

' extract unique entries from the "raw data" range
' store in a comma delimited string
Dim V As Variant
SDVString = ""
For Each V In d.Keys()
    ' d.Keys() is a Variant array of the unique values in myArray.
    ' v will iterate through each of them.
    ' Debug.Print v
    If V <> "" Then
        SDVString = SDVString & V & ","
    End If
Next 'V

On Error Resume Next
SDVString = Left(SDVString, Len(SDVString) - 1)
' If there is no data, set the string to "Error"
' This ensures the Data Validation Add does not fail
If Err.Number <> 0 Then SDVString = "Error"
On Error GoTo 0

' Add the Data Validation to the Primary Drop Down List
With ActiveSheet
    .Unprotect Password:=shPW
    On Error Resume Next
    With .Range(sDVOut).Validation
        .Delete
        .Add _
            Type:=xlValidateList, _
            AlertStyle:=xlValidAlertStop, _
            Operator:=xlBetween, _
            Formula1:=SDVString
        .IgnoreBlank = False
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
    On Error GoTo 0
    sProtectSheet ActiveSheet
End With

' End of Generic Worksheet Selection Change subroutine
End Sub

Basically, it takes a range and puts that into an array. It then creates an array (Dictionary) of unique entries. Then it loops through the unique entries and builds a comma separated string. This is then used as the Data Validation List. Bit tedious but it's quite fast and works (at least in the project I created it for.)

Regards, TMS

[pezalmendra]

Hey thanks! I will give it a try

Regards

[TMS]

You're welcome.