Make a new column without duplicates VBA?

Question

I have a column of cells whose values are something like this:

a
a
b
b
c
c
c
c
d
e
f
f

etc.

I\'m looking to take the non-duplicate

Answer 1

For completeness, I'm posting the Scripting.Dictionary method: it's the commonest alternative to using a VBA.Collection and it avoids the need to rely on error-handling in normal operation.

A VBA Function using the Scripting.Dictionary Object to Return Unique Values from an Excel Range Containing Duplicates:

Option Explicit


'           Author: Nigel Heffernan
'           May 2012  http://excellerando.blogspot.com

'           **** THIS CODE IS IN THE PUBLIC DOMAIN ****
'
'           You are advised to segregate this code from
'           any proprietary or commercially-confidential
'           source code, and to label it clearly. If you
'           fail do do so, there is a risk that you will
'           impair your right to assert ownership of any
'           intellectual property embedded in your work,
'           or impair your employers or clients' ability
'           to do so if the intellectual property rights
'           in your work have been assigned to them.
'

Public Function UniqueValues(SourceData As Excel.Range, _
                             Optional Compare As VbCompareMethod = vbBinaryCompare _
                             ) As Variant
Application.Volatile False

' Takes a range of values and returns a single-column array of unique items.

' The returned array is the expected data structure for Excel.Range.Value():
' a 1-based 2-Dimensional Array with dimensions 1 to RowCount, 1 to ColCount

' All values in the source are treated as text, and uniqueness is determined
' by case-sensitive comparison. To change this, set the Compare parameter to
' to 1, the value of the VbCompareMethod enumerated constant 'VbTextCompare'

' Error values in cells are returned as "#ERROR" with no further comparison.
' Empty or null cells are ignored: they do not appear in the returned array.


Dim i As Long, j As Long, k As Long
Dim oSubRange As Excel.Range
Dim arrSubRng As Variant
Dim arrOutput As Variant
Dim strKey    As String
Dim arrKeys   As Variant

Dim dicUnique As Object

' Note the late-binding as 'object' - best practice is to create a reference
' to the Windows Scripting Runtime: this allows you to declare dictUnique as
' Dim dictUnique As Scripting.Dictionary  and instantiate it using the 'NEW'
' keyword instead of CreateObject, giving slightly better speed & stability.

If SourceData Is Nothing Then
    Exit Function
End If

If IsEmpty(SourceData) Then
    Exit Function
End If

Set dicUnique = CreateObject("Scripting.Dictionary")
    dicUnique.CompareMode = Compare

For Each oSubRange In SourceData.Areas   ' handles noncontiguous ranges

    'Use Worksheetfunction.countA(oSubRange) > 0 to ignore empty ranges

    If oSubRange.Cells.Count = 1 Then
        ReDim arrSubRng(1 To 1, 1 To 1)
        arrSubRng(1, 1) = oSubRange.Cells(1, 1).Value
    Else
        arrSubRng = oSubRange.Value
    End If

    For i = LBound(arrSubRng, 1) To UBound(arrSubRng, 1)
        For j = LBound(arrSubRng, 2) To UBound(arrSubRng, 2)
            If IsError(arrSubRng(i, j)) Then
                dicUnique("#ERROR") = vbNullString
            ElseIf IsEmpty(arrSubRng(i, j)) Then
                ' no action: empty cells are ignored
            Else
            '   We use the error-tolerant behaviour of the Dictionary:
            '   If you query a key that doesn't exist, it adds the key
                dicUnique(CStr(arrSubRng(i, j))) = vbNullString
            End If
        Next j
    Next i

    Erase arrSubRng

Next oSubRange

If dicUnique.Count = 0 Then
    UniqueValues = Empty
Else
    arrKeys = dicUnique.keys
    dicUnique.RemoveAll

    ReDim arrOutput(1 To UBound(arrKeys) + 1, 1 To 1)
    For k = LBound(arrKeys) To UBound(arrKeys)
        arrOutput(k + 1, 1) = arrKeys(k)
    Next k
    Erase arrKeys

    UniqueValues = arrOutput

    Erase arrOutput
End If

Set dicUnique = Nothing

End Function

A couple of notes:

1. This is code for any Excel range, not just the single-column range you asked for.
2. This function tolerates cells with errors, which are difficult to handle in VBA.
3. This isn't Reddit: you can read the comments, they are an aid to understanding and generally beneficial to your sanity.