Macro to write dictionary keys to array not working - excel

Question

I am trying to use a dictionary to create array of unique items from a column range
The column cells are text (titles)
I know very little about dictionaries, trying to learn something new
I get an array filled with 1's
Thanks
Sub GetUniques()
Dim d As Object, k, a As Variant, c As Variant, i As Long, j As Long, LR As Long
Set d = CreateObject("Scripting.Dictionary")
LR = Cells(Rows.Count, 1).End(xlUp).Row
c = Range("D2:D" & LR).Value2
For i = 1 To UBound(c)
d(c(i, 1)) = 1
Next i
ReDim a(1 To d.Count)
j = 1
For Each k In d.keys
a(j) = k
j = j + 1
Next k
'See what the first item of the array is
MsgBox a(1)
End Sub

Answer 1

I use collection to create unique items. Here is an example
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long, i As Long
Dim Col As New Collection, itm As Variant
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 1 To lRow
On Error Resume Next
Col.Add .Range("A" & i).Value, CStr(.Range("A" & i).Value)
On Error GoTo 0
Next i
End With
For Each itm In Col
Debug.Print itm
Next
End Sub
EDIT
And if you want to convert that collection to array then you can add this code
Dim MyAr() As Variant
ReDim MyAr(0 To (Col.Count - 1))
For i = 1 To Col.Count
MyAr(i - 1) = Col.Item(i)
Next
Followup from comments
Is this what you are trying?
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long, i As Long
Dim Col As New Collection, itm As Variant
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 1 To lRow
On Error Resume Next
Col.Add .Range("A" & i).Value, CStr(.Range("A" & i).Value)
On Error GoTo 0
Next i
End With
Dim MyAr() As Variant
ReDim MyAr(0 To (Col.Count - 1))
For i = 1 To Col.Count
MyAr(i - 1) = Col.Item(i)
Next
ws.Range("K1").Resize(UBound(MyAr), 1) = Application.Transpose(MyAr)
End Sub
Note: I see that your query is solved but If I was you, I would use the inbuilt RemoveDuplicates which is much more faster and shorter than the code above
Columns(1).Copy Columns(11)
Columns(11).RemoveDuplicates Columns:=1, Header:=xlNo