Hi,
I was trying to Get Unique List by Using Array Function and the Output is
below , it's a array Function To Get Unique values List From Given Range
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
-----Original Message-----
From: Rajan_Verma [mailto:rajanverma1...@gmail.com]
Sent: Saturday, August 06, 2011 9:59 AM
To: 'excel-macros@googlegroups.com'
Subject: RE: $$Excel-Macros$$ UNIQUE values in Array
Hope this will Help You.
Function UniqueList(rng As Range, Pos As Long) As String
Dim List() As String
Dim cell As Range
Dim i As Long
Dim t As Long
i = 0
ReDim List(rng.Cells.Count) As String
For Each cell In rng
flag = 0
For t = LBound(List) To UBound(List)
If cell.Value = List(t) Then
flag = 1
Exit For
End If
Next
If flag = 0 Then
List(i) = cell.Value
i = i + 1
End If
Next
UniqueList = List(Pos)
End Function
-----Original Message-----
From: excel-macros@googlegroups.com [mailto:excel-macros@googlegroups.com]
On Behalf Of hanumant shinde
Sent: Saturday, August 06, 2011 2:20 AM
To: Excel Group
Subject: $$Excel-Macros$$ UNIQUE values in Array
Hi friends,
i have some values in column A. i want to take only UNIQUE values in some
array.
how can i do so?
i have developed below function and is working exactly i want it to be but i
think there should be more efficient way of doing so like there may be array
function for storing only UNIQUE values or anything like that.
Sub UniqueArray()
Dim newarr() As String
Dim blnmatchfnd As Boolean
j = 0
For i = 1 To 46
ReDim Preserve newarr(j)
For k = 0 To UBound(newarr)
If newarr(k) = Range("A" & i).Value Then
blnmatchfnd = True
Exit For
Else
blnmatchfnd = False
End If
Next k
If blnmatchfnd = False Then
ReDim Preserve newarr(j)
newarr(j) = Range("A" & i).Value
Range("B" & j + 1).Value = newarr(j)
j = j + 1
End If
Next i
End Sub
--
----------------------------------------------------------------------------
------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/discussexcel
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/discussexcel
