Hi Howard,

Am Mon, 8 Dec 2014 23:29:39 -0800 (PST) schrieb L. Howard:

[B:B,C:C].ClearContents

here you clear B:B

'With WorksheetFunction
' myMax = Evaluate("=Max(CountIf(A1:A200,A1:A200))")
'End With
' MsgBox myMax

With Sheets("Sheet1")
lr = .Cells(Rows.Count, "A").End(xlUp).Row
vArray = .Range("A1:A" & lr)
k = .Range("F1")

For i = 2 To UBound(vArray)
If vArray(i, 1) = vArray(i - 1, 1) Then
j = j + 1
If j = k Then
.Cells(i - 1, 2) = vArray(i, 1) & " = " & j & " times"
j = 0
End If
Else
j = 0
End If
Next 'i

But you write nothing to B. So vArray = empty
lr = .Cells(Rows.Count, 2).End(xlUp).Row
vArray = .Range("B1:B" & lr)
k = 0

ReDim Preserve varOut(WorksheetFunction.CountA(.Range("B:B")) - 1, 0)

CountA(Range("B:B")) = 0

please tell me in words what you want to do.


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional