Sub SimpleCollection()
'*********************************************************
'This procedure reads the values in cell A1 and down to
'the first empty cell and add them to a collection.
'After that the values are written to cell C1 and down.
'*********************************************************
Dim colMyCol As New Collection 'Our collection
Dim vElement 'Variant to represent an element
Dim rRange As Range 'Range variable
Dim rCell As Range 'Range variable
Dim lCount As Long 'Counter
Set rRange = Range("A1")
'If cell A1 is empty we cancel and leave the procedure.
If Len(rRange.Value) = 0 Then GoTo BeforeExit
'If there is anything in A2, we expand rRange to the last empty cell.
If Len(rRange.Offset(1, 0).Value) > 0 Then
Set rRange = Range(rRange, rRange.End(xlDown))
End If
'Now the cell values are added to the collection.
'Notice that we DON'T give the items a name (key).
For Each rCell In rRange
colMyCol.Add rCell.Value
Next
'Now we write the values to cell C1 and down.
'Just like a range a collection can be looped with
'For Each...Next.
For Each vElement In colMyCol
Range("C1").Offset(lCount, 0).Value = vElement
lCount = lCount + 1
Next
BeforeExit:
Set colMyCol = Nothing
Set rRange = Nothing
Set rCell = Nothing
Exit Sub
ErrorHandle:
MsgBox Err.Description & " Error in procedure SimpleCollection"
Resume BeforeExit
End Sub