Harlan Grove said:
. . . More general and perhaps more efficient would be a udf
wrapper around VBA's StrComp. On my to-do list.
And now off my to-do list because here it is.
Function astrcmp( _
a As Variant, _
b As Variant, _
Optional cm As Long = 1 _
) As Variant
'-----------------------------------------------------------
'intended to be used as a udf wrapper around VBA's StrComp
'-----------------------------------------------------------
Dim aa As Variant, bb As Variant, rv As Variant
Dim d(1 To 2, 1 To 2) As Long, e(1 To 2, 1 To 2) As Long
Dim i As Long, j As Long
'quickly handle two scalars
If Not (IsArray(a) Or IsArray(b)) Then
If IsError(a) Then
astrcmp = a
ElseIf IsError(b) Then
astrcmp = b
Else
astrcmp = StrComp(a, b, cm)
End If
Exit Function
End If
'only use first area of range arguments
If TypeOf a Is Range Then a = a.Areas(1).Value
If TypeOf b Is Range Then b = b.Areas(1).Value
'get dimensions to be used with 0-based result
On Error Resume Next
d(1, 1) = -1
d(1, 1) = UBound(a, 1) - LBound(a, 1)
d(1, 2) = -1
d(1, 2) = UBound(a, 2) - LBound(a, 2)
d(2, 1) = -1
d(2, 1) = UBound(b, 1) - LBound(b, 1)
d(2, 2) = -1
d(2, 2) = UBound(b, 2) - LBound(b, 2)
Err.Clear
On Error GoTo 0
'load a into a possibly degenerate 2D array aa
If d(1, 1) = -1 Then
ReDim aa(0 To 0, 0 To 0)
aa(0, 0) = a
d(1, 1) = 0
d(1, 2) = 0
ElseIf d(1, 2) = -1 Then
ReDim aa(0 To 0, 0 To d(1, 1))
For j = 0 To d(1, 1)
aa(0, j) = a(j + LBound(a, 1))
Next j
d(1, 2) = d(1, 1)
d(1, 1) = 0
Else
ReDim aa(0 To d(1, 1), 0 To d(1, 2))
For i = 0 To d(1, 1)
For j = 0 To d(1, 2)
aa(i, j) = a(i + LBound(a, 1), j + LBound(a, 2))
Next j
Next i
End If
'load b into a possibly degenerate 2D array bb
If d(2, 1) = -1 Then
ReDim bb(0 To 0, 0 To 0)
bb(0, 0) = b
d(2, 1) = 0
d(2, 2) = 0
ElseIf d(2, 2) = -1 Then
ReDim bb(0 To 0, 0 To d(2, 1))
For j = 0 To d(2, 1)
bb(0, j) = b(j + LBound(b, 1))
Next j
d(2, 2) = d(2, 1)
d(2, 1) = 0
Else
ReDim bb(0 To d(2, 1), 0 To d(2, 2))
For i = 0 To d(2, 1)
For j = 0 To d(2, 2)
bb(i, j) = b(i + LBound(b, 1), j + LBound(b, 2))
Next j
Next i
End If
'set return value array's dimensions to the larger of
'aa's and bb's row and column dimensions
ReDim rv(0 To IIf(d(1, 1) > d(2, 1), d(1, 1), d(2, 1)), _
0 To IIf(d(1, 2) > d(2, 2), d(1, 2), d(2, 2)))
For i = 0 To UBound(rv, 1)
For j = 0 To UBound(rv, 2)
If (i > d(1, 1) And d(1, 1) > 0) Or (i > d(2, 1) And d(2, 1) > 0) _
Or (j > d(1, 2) And d(1, 2) > 0) Or (j > d(2, 2) And d(2, 2) > 0) _
Then
rv(i, j) = CVErr(xlErrNA)
Else
e(1, 1) = LBound(aa, 1) + IIf(d(1, 1) > 0, i, 0)
e(1, 2) = LBound(aa, 2) + IIf(d(1, 2) > 0, j, 0)
e(2, 1) = LBound(bb, 1) + IIf(d(2, 1) > 0, i, 0)
e(2, 2) = LBound(bb, 2) + IIf(d(2, 2) > 0, j, 0)
rv(i, j) = StrComp(aa(e(1, 1), e(1, 2)), bb(e(2, 1), e(2, 2)), cm)
End If
Next j
Next i
astrcmp = rv
End Function
Not elegant, but it seems to reproduce Excel's range/array size semantics
when used as operands. Well, not quite - if fed a 1D array and either a
scalar or another 1D array, it returns a 2D array with degenerate row
dimension, e.g., rv(0 to 0, 0 to whatever). I could have dealt with that as
a special case, but I didn't see the point.
Anyway, with this udf, counting text in case-sensitive fashion becomes a
simple matter of using this inside a SUMPRODUCT call.
COUNTIF(X,"=Y")
=SUMPRODUCT(--(astrcmp(X,"Y",0)=0))
COUNTIF(X,"<>Y")
=SUMPRODUCT(--(astrcmp(X,"Y",0)<>0))
COUNTIF(X,"<Y")
=SUMPRODUCT(--(astrcmp(X,"Y",0)<0))
COUNTIF(X,"<=Y")
=SUMPRODUCT(--(astrcmp(X,"Y",0)<=0))
COUNTIF(X,">=Y")
=SUMPRODUCT(--(astrcmp(X,"Y",0)>=0))
COUNTIF(X,">Y")
=SUMPRODUCT(--(astrcmp(X,"Y",0)>0))
