Harlan Grove wrote:
. . .

Since ArrayUniques has the function definition

Function ArrayUniques(InputArray, _
Optional MatchCase As Boolean = True, _
Optional Base_Orient As String = "1vert", _
Optional OmitBlanks As Boolean = True)

I can see how it could include or exclude blanks, but how would one
need to call it to count distinct numbers or text in ranges that could
also include booleans and errors?


The following is an extended ArrayUniques function that can be used to
count unique elements in a range. It can be used independently of the
other functions at http:/home.pacbell.net/beban in versions later than
xl2000 or if the number of elements in the range is 5461 or less. To
return the count it could be called like

=ROWS(ExtendedArrayUniques(Rng))

Called that way it will return the number of unique entries in Rng,
omitting any blanks (by default; adjusted with the 4th argument) and
invoking case matching (by default; adjusted with the 2nd argument). The
3rd argument is irrelevant to the counting function, used only to
control the orientation (horizontal or vertical, and the base (0 or 1)
of the array output by the function. The function definition is

Function ExtendedArrayUniques(InputArray, _
Optional MatchCase As Boolean = True, _
Optional Base_Orient As String = "1vert", _
Optional OmitBlanks As Boolean = True, _
Optional Criterion As String)

The acceptable parameters for Criterion, in addition to no entry, are

"ISTEXT"
"ISNUMBER"
"ISERROR"
"ISLOGICAL"
"PositiveNumbers"
"NumbersOrText"

If any other parameter is entered for Criterion, it will return a
#VALUE! error. Watch for word wrap.

Function ExtendedArrayUniques(InputArray, _
Optional MatchCase As Boolean = True, _
Optional Base_Orient As String = "1vert", _
Optional OmitBlanks As Boolean = True, _
Optional Criterion As String)
'THIS PROCEDURE REQUIRES A PROJECT REFERENCE
'TO "MICROSOFT SCRIPTING RUNTIME".
'The function returns an array of unique
'values from an array or range. By default
'it returns a 1-based vertical array; for
'other results enter "0horiz", "1horiz" or
'"0vert" as the third argument. By default,
'the function is case-sensitive; i.e., e.g.,
'"red" and "Red" are treated as two separate
'unique values; to avoid case-sensitivity,
'enter False as the second argument.

'Declare the variables
Dim arr, arr2
Dim i As Long, p As Object, q As String
Dim Elem, x As Dictionary
Dim CalledDirectFromWorksheet As Boolean
'For later use in selecting cells for worksheet output
CalledDirectFromWorksheet = False
If TypeOf Application.Caller Is Range Then
Set p = Application.Caller
q = p.Address
iRows = Range(q).Rows.count
iCols = Range(q).Columns.count
If InStr(1, p.FormulaArray, "ExtendedArrayUniques") = 2 _
Or InStr(1, p.FormulaArray, "extendedarrayuniques") = 2 _
Or InStr(1, p.FormulaArray, "EXTENDEDARRAYUNIQUES") = 2 Then
CalledDirectFromWorksheet = True
End If
End If

'Convert an input range to a VBA array
arr = InputArray

'Load the unique elements into a Dictionary Object
Set x = New Dictionary
x.CompareMode = Abs(Not MatchCase) '--Case-sensitivity
On Error Resume Next
Select Case Criterion
Case ""
For Each Elem In arr
x.Add Item:=Elem, key:=CStr(Elem)
Next
If OmitBlanks Then x.Remove ("")
Case "ISTEXT"
For Each Elem In arr
If Application.IsText(Elem) Then x.Add Item:=Elem,
key:=CStr(Elem)
Next
If OmitBlanks Then x.Remove ("")
Case "ISERROR"
For Each Elem In arr
If Application.IsError(Elem) Then x.Add Item:=Elem,
key:=CStr(Elem)
Next
Case "ISLOGICAL"
For Each Elem In arr
If Application.IsLogical(Elem) Then x.Add Item:=Elem,
key:=CStr(Elem)
Next
Case "PositiveNumbers"
For Each Elem In arr
If Application.IsNumber(Elem) And Elem 0 Then
If Not IsError(Elem) Then x.Add Item:=Elem,
key:=CStr(Elem)
End If
Next
Case "NumbersOrText"
For Each Elem In arr
If Application.IsNumber(Elem) Or
Application.IsText(Elem) Then
x.Add Item:=Elem, key:=CStr(Elem)
If OmitBlanks Then x.Remove ("")
End If
Next
Case Else
ExtendedArrayUniques = CVErr(xlValue)
End Select
On Error GoTo 0

'Load a 0-based horizontal array with the unique
'elements from the Dictionary Object
arr2 = x.Items

'This provides appropriate base and orientation
'of the output array
Select Case Base_Orient
Case "0horiz"
arr2 = arr2
Case "1horiz"
ReDim Preserve arr2(1 To UBound(arr2) + 1)
Case "0vert"
If x.count 5461 Or Application.Version 9 Then
arr2 = Application.Transpose(arr2)
Else
arr2 = ArrayTranspose(arr2)
End If
Case "1vert"
If UBound(arr2) = -1 Then
If CalledDirectFromWorksheet Then
ExtendedArrayUniques = CVErr(xlValue)
Else
ExtendedArrayUniques = [#Value!]
End If
Exit Function
End If
ReDim Preserve arr2(1 To UBound(arr2) + 1)
If x.count 5461 Or Application.Version 9 Then
arr2 = Application.Transpose(arr2)
Else
arr2 = ArrayTranspose(arr2)
End If
End Select
'Assure that enough cells are selected to accommodate output
If CalledDirectFromWorksheet Then
If Range(Application.Caller.Address).count x.count Then
ExtendedArrayUniques = "Select a range of at least " & x.count
& " cells"
Exit Function
End If
End If

ExtendedArrayUniques = arr2

End Function

Alan Beban