How to add an array into an in cell dropdown from a scripting dictionary?

Question

I have a data dump from different application. I want to get unique values from a singular column in the data dump (which has variable length). Once I have the unique values I want them to be called into an .incelldropdown from data validation. I've figured out most of this except for the last part where I get the error:

Runtime Application Error: "1004" Application or object defined error.

See below:

Sub TitleRange()

Dim sheet As Worksheet
Dim LastRow As Long
Dim StartCell As Range
Dim RangeArray As Variant


Worksheets("Raw").Select
Set sheet = Worksheets("Raw")
Set StartCell = Range("A2")

'Find Last Row
 LastRow = Cells(Rows.Count, "A").End(xlUp).Row

'Select Range & load into array
 RangeArray = sheet.Range("A2:A" & LastRow).Value



Dim d As Object
Set d = CreateObject("Scripting.Dictionary")


Dim i As Long
For i = LBound(RangeArray) To UBound(RangeArray)
d(RangeArray(i, 1)) = 1
Next i

Dim v As Variant
For Each v In d.Keys()
'd.Keys() is a Variant array of the unique values in RangeArray.
'v will iterate through each of them.
Next v


'This code below gives me a problem
Worksheets("PR Offer Sheet").Select
Range("C1").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=d.Keys()
.InCellDropdown = True

End With

The debugger says the problem is the d.Keys() from scripting. However, I've tried to convert into a string using Join (d.Keys(), ",") and calling that new variable in the data validation which yields same error. I am running this on Excel 2010.

I thought this also might be a problem that the variant array is 2D and it needs to be 1D but that doesn't seem to be the case.

Have you tried [this solution?](https://stackoverflow.com/questions/39162841/is-it-ppossible-to-use-autofilter-or-find-on-a-dictionary) Just use the initialize part, take out the `cboEEList_Change()`, that filters the list. — danieltakeshi, Oct 30 '17 at 16:10
Here: `d(RangeArray(i, 1)) = 1` you are inserting just value 1 on the Dictionary. — danieltakeshi, Oct 30 '17 at 16:15

SJR · Answer 1 · 2017-10-30T16:34:05.867

1

This works for me. xlValidateList is expecting a list separated by commas (or a range). I have also removed the Select and Activate statements which are not needed and slow code down.

Sub TitleRange()

Dim sheet As Worksheet
Dim LastRow As Long
Dim RangeArray As Variant
Dim i As Long
Dim d As Object

Set sheet = Worksheets("Raw")

With sheet
    'Find Last Row
    LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
    'Select Range & load into array
    RangeArray = .Range("A2:A" & LastRow).Value
End With

Set d = CreateObject("Scripting.Dictionary")

For i = LBound(RangeArray) To UBound(RangeArray)
    d(RangeArray(i, 1)) = 1
Next i

With Worksheets("PR Offer Sheet").Range("C1").Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(d.Keys, ",")
    .InCellDropdown = True
End With

End Sub

edited Oct 30 '17 at 16:34

answered Oct 30 '17 at 16:14

SJR

22,986
6
18
26

This code ran for me as well but the output is giving only the first four values of the array. The array itself is populated correctly - you can see this by running: Cells(1, 40).Resize(UBound(d.Keys()) + 1, 1) = Application.WorksheetFunction.Transpose(d.Keys()). Any ideas? – Antonio Nov 02 '17 at 20:45
Funny, I can't replicate that. How many values should it be showing? – SJR Nov 03 '17 at 10:17
It should be showing about 670 items and as mentioned it's only displaying to me first 4 – Antonio Nov 03 '17 at 20:01
There is a character limit which may apply here. See http://www.contextures.com/xlDataVal08.html can you try with a smaller list (256 characters or less) and see if that works. If that is the problem, the workaround might be to dump the list to the spreadsheet and then use that as the limit is then 32,767 items. – SJR Nov 03 '17 at 21:36

score 1 · Answer 2 · answered Oct 30 '17 at 19:32

This appears to work:

Sub MAIN2()
    Dim it As Range, r As Range, x0, s As String
        With CreateObject("scripting.dictionary")
            For Each it In Sheets("Raw").Columns(1).SpecialCells(2).Offset(1)
                x0 = .Item(it.Value)
            Next

            s = Join(.Keys, ",")

        End With
        With Worksheets("PR Offer Sheet").Range("C1").Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=s
                .InCellDropdown = True
        End With
End Sub

How to add an array into an in cell dropdown from a scripting dictionary?

2 Answers2