Try this and see if it does what you want. If not, it can be adjusted.
Function CountConsecutive(MyString As String, MyRange As Range)
Dim Count As Long, MaxCount As Long, Cll As Range
For Each Cll In MyRange
If Cll.Value = MyString Then
Count = Count + 1
If Count > MaxCount Then MaxCount = Count
Count = 0
CountConsecutive = MaxCount
BTW, this was found on...........I think Ozgrid. This is NOT my original work/concept.