Tuesday, August 9, 2011

Get Unique List : Another Method


if You want to get Unique list from a Range ,You ca use this array Function :

Function GetUniqueList(rng As Range) As Variant

On Error Resume Next
 
    Dim Arr() As Variant
    Dim cell As Range
    Dim r, c As Integer
    Dim i, j As Integer
    i = 0: j = 0
   
    With Application.Caller
    r = .Rows.Count
    c = .Columns.Count
    End With
    ReDim Arr(r - 1, c - 1)

    For Each cell In rng
    If WorksheetFunction.CountIf(rng.Cells(1, 1).Resize(cell.Row, 1), cell.Value) = 1 Then
        Arr(i, j) = cell.Value
        If j = c Then j = j + 1
        i = i + 1
        End If
       
     For k = i To UBound(Arr())
     Arr(k, 0) = ""
     Next
    Next
    GetUniqueList = Arr
End Function

No comments: