Hans,

I wrote a short macro to copy your data range to a blank column in your workbook and then use RemoveDuplicates to speed up the process. This new range of unique values is then cycled through in reverse to populate your destination list. Finally, the temporary column we added is cleared.

Hope this helps,

Ben

Sub ListPrograms()
Dim rCopy As Range 'Range of values to check
Dim rCopy2 As Range 'Blank cell at the top of an unused column
Dim x As Long 'Used for cycling through the rCopy2 range
Dim y As Long 'Used for cycling through the rPaste range
Dim rPaste As Range 'First cell to receive the data

'First, set up the copy from range and the copy/paste to range
'Application.ScreenUpdating = False 'Uncomment this line if macro runs slow

Set rCopy = Sheet3.Range("D1:D" & Sheet1.Range("D64000").End(xlUp).Row)
Set rCopy2 = Sheet1.Range("E1") 'Empty column somewhere in your workbook
Set rPaste = Sheet2.Range("A5")

y = 0 'Set to zero to start

'Next, resize the rCopy2 range to match the rCopy range size and copy the data
Set rCopy2 = rCopy2.Resize(rCopy.Rows.Count, 1)
rCopy.Copy rCopy2

'Now, remove duplicates (assumes no headers)
rCopy2.RemoveDuplicates 1, xlNo

'Once again resize rCopy2 to cover reduced data range
'**(Check next line to ensure that the sheet name and column are correct)
Set rCopy2 = Sheet1.Range("E1:E" & Sheet1.Range("E64000").End(xlUp).Row)

'Now, cycle through each value in rCopy2 starting from the bottom _
and paste it to the final destination.
For x = rCopy2.Rows.Count To 1 Step -1
rPaste.Offset(y, 0).Value = rCopy2.Cells(x, 1)
y = y + 1 'Increment y to ensure next value goes into the cell below
Next x

'Finally, clear the rCopy2 range as it is no longer necessary.
rCopy2.Clear
Application.ScreenUpdating = True

End Sub