Re: Remove Duplicates from a Range Macro Problem (Page 89 Ma
That example does work, here is how.
First, in range A1:A17 are these values (note A1 is a header value, meaning the actual data we care about is in A2:A17):
Column A
1 Source
2 A
3 R
4 T
5 A
6 V
7 F
8 EE
9 1
10 19
11 V
12 Q
13 V
14 GE
15 V
16123
17 1
Next, as the book indicated, the quantity of unique values was determined by a user defined function named NumUniqueValues.
The UDF code is:
Function NumUniqueValues(Rng As Range) As Long
Dim myCell As Range, UniqueVals As New Collection
Application.Volatile
On Error Resume Next
For Each myCell In Rng
UniqueVals.Add myCell.Value, CStr(myCell.Value)
Next myCell
On Error GoTo 0
NumUniqueValues = UniqueVals.Count
End Function
So if you enter this UDF in, say, cell C1, it will return 11:
=NumUniqueValues(A2:A17)
Now you know there are 11 unique values in the range A2:A17.
In a standard module, as the book outlines, is this code for the UDF array you are asking about:
Option Explicit
Const ERR_BAD_PARAMETER = "Array parameter required"
Const ERR_BAD_TYPE = "Invalid Type"
Const ERR_BP_NUMBER = 20000
Const ERR_BT_NUMBER = 20001
Public Function UniqueValues(ByVal OrigArray As Variant) As Variant
Dim vAns() As Variant
Dim lStartPoint As Long
Dim lEndPoint As Long
Dim lCtr As Long, lCount As Long
Dim iCtr As Integer
Dim col As New Collection
Dim sIndex As String
Dim vTest As Variant, vItem As Variant
Dim iBadVarTypes(4) As Integer
'Function does not work if array element is one of the
'following types
iBadVarTypes(0) = vbObject
iBadVarTypes(1) = vbError
iBadVarTypes(2) = vbDataObject
iBadVarTypes(3) = vbUserDefinedType
iBadVarTypes(4) = vbArray
'Check to see whether the parameter is an array
If Not IsArray(OrigArray) Then
Err.Raise ERR_BP_NUMBER, , ERR_BAD_PARAMETER
Exit Function
End If
lStartPoint = LBound(OrigArray)
lEndPoint = UBound(OrigArray)
For lCtr = lStartPoint To lEndPoint
vItem = OrigArray(lCtr)
'First check to see whether variable type is acceptable
For iCtr = 0 To UBound(iBadVarTypes)
If VarType(vItem) = iBadVarTypes(iCtr) Or _
VarType(vItem) = iBadVarTypes(iCtr) + vbVariant Then
Err.Raise ERR_BT_NUMBER, , ERR_BAD_TYPE
Exit Function
End If
Next iCtr
'Add element to a collection,using it as the index
'if an error occurs,the element already exists
sIndex = CStr(vItem)
'first element,add automatically
If lCtr = lStartPoint Then
col.Add vItem, sIndex
ReDim vAns(lStartPoint To lStartPoint) As Variant
vAns(lStartPoint) = vItem
Else
On Error Resume Next
col.Add vItem, sIndex
If Err.Number = 0 Then
lCount = UBound(vAns) + 1
ReDim Preserve vAns(lStartPoint To lCount)
vAns(lCount) = vItem
End If
End If
Err.Clear
Next lCtr
UniqueValues = vAns
End Function
Function nodupsArray(Rng As Range) As Variant
Dim arr1() As Variant
If Rng.Columns.Count > 1 Then Exit Function
arr1 = Application.Transpose(Rng)
arr1 = UniqueValues(arr1)
nodupsArray = Application.Transpose(arr1)
End Function
Now if you select the quantity of cells which is the same as the known quantity of unique values (11) and enter the UDF array you will get the same results as the book suggests.
Example, select E1:E11, meaning E1 is the active cell with E1:E11 selected.
Type in:
=NoDupsArray($A$2:$A$17)
and press Ctrl+Shift+Enter
That will return each of the 11 unique elements from A2:A17 into E1:E11.