Unique List

[Clare1805]

I have a list of names on one tab which is constantly updated; I need to extract the unique values and paste them into a seperate tab.

I know I could use an advanced filter and paste into the relevant sheet but as the spreadsheet gets updated several times a day, it would be much easier if this could be done via a macro. Any ideas?

 

[Andrew Poulsom]

Have you tried recording a macro while filtering manually? You could put the code in the Worksheet_Change event procedure.

 

[chirp]

here are a couple ways to get you started, please ask if you are unsure how to use this code.

method 1:

Public Function getUniqueArray(inputRange As Range, _
                                Optional skipBlanks As Boolean = True, _
                                Optional matchCase As Boolean = True, _
                                Optional prepPrint As Boolean = True _
                                ) As Variant
               
Dim vDic As Object
Dim tArea As Range
Dim tArr As Variant, tVal As Variant, tmp As Variant
Dim noBlanks As Boolean
Dim cnt As Long
                      
On Error GoTo exitFunc:
If inputRange Is Nothing Then GoTo exitFunc

With inputRange
    If .Cells.count < 2 Then
        ReDim tArr(1 To 1, 1 To 1)
        tArr(1, 1) = .Value2
        getUniqueArray = tArr
        GoTo exitFunc
    End If

    Set vDic = CreateObject("scripting.dictionary")
    If Not matchCase Then vDic.compareMode = vbTextCompare
    
    noBlanks = True
    
    With vDic
        For Each tArea In .Areas
            tArr = tArea.Value2
            For Each tVal In tArr
                If tVal <> vbNullString Then
                    .Item(tVal) = Empty
                ElseIf noBlanks Then
                    noBlanks = False
                End If
            Next
        Next
    End With
End With

If Not skipBlanks Then If Not noBlanks Then vDic.Item(vbNullString) = Empty

'this is done just in the case of large data sets where the limits of
'transpose may be encountered
If prepPrint Then
    ReDim tmp(1 To vDic.count, 1 To 1)
    For Each tVal In vDic.Keys
        cnt = cnt + 1
        tmp(cnt, 1) = tVal
    Next
    getUniqueArray = tmp
Else
    getUniqueArray = vDic.Keys
End If

exitFunc:
Set vDic = Nothing
End Function

method 2:

Public Function uniqueCopy(rng As Range, _
                                Optional copyTo As Range, _
                                Optional tst As Boolean)

tst = False
On Error GoTo exitFunc
If rng Is Nothing Then GoTo exitFunc

If Not copyTo Is Nothing Then
    rng.AdvancedFilter xlFilterCopy, , copyTo, True
Else: rng.AdvancedFilter xlFilterInPlace, , , True
End If
    
tst = True
exitFunc:
End Function