L

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 vltem = 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

Here is an example of using this function. See Figure 4.8 for the result on a worksheet:

Function nodupsArray(rng As Range) As Variant Dim arr1() As Variant

If rng.Columns.Count > 1 Then Exit Function arrl = Application.Transpose(rng) arrl = UniqueValues(arrl) nodupsArray = Application.Transpose(arrl) End Function

Figure 4.8

List unique values from a range.

0 0

Post a comment