this works...


Option Explicit

Function str3(irng As Range, ii As Integer)

Dim i As Long
Dim j As Long
Dim data
Dim str2(), str1, str4

data = irng.Value
ReDim str2(1 To UBound(data, 1))

For i = 1 To UBound(data, 1)
str1 = 1: str4 = 1
For j = 2 To UBound(data, 2)

If data(i, j) <> "" Then
If data(i, j) = data(i, j - 1) Then
str4 = str4 & "_" & str1
Else
str1 = str1 + 1
str4 = str4 & "_" & str1
End If
End If

Next

str2(i) = str4
Next

ReDim Preserve str2(1 To UBound(data, 1))
ReDim ds(0 To UBound(data, 2)) As Integer
Dim jj As Integer, r As Variant

'-------------------below part not work
'On Error Resume Next

For i = 1 To UBound(data, 1)
r = Split(str2(i), "_"): ' Debug.Print r(UBound(r))

For j = 1 To r(UBound(r))
'jj = WorksheetFunction.CountIf(WorksheetFunction.Transpose
(r), j)
jj = mem_countif(r, j)
ds(jj) = ds(jj) + 1
Next

Next

str3 = ds(ii)

End Function

Sub ca()

MsgBox str3(Sheet1.Range("c5:f12"), 3)

End Sub

'http://www.ozgrid.com/forum/showthread.php?t=68838
Function mem_countif(r, j)
'Dim a(), i&, iCnt&
'a = Array(1, 2, 3, 4, 5)
Dim i&, iCnt&
iCnt = 0
For i = 0 To UBound(r)
iCnt = iCnt - (Val(r(i)) = j)
Next i
mem_countif = iCnt
End Function