Sub test()
Dim ar, i&, j&, k&, s$
s = "111"
ar = Range([h14:r14], [h14:r14].End(xlDown))
For i = 1 To UBound(ar)
k = 0
For j = 1 To UBound(ar, 2) Step 4
If ar(i, j) & ar(i, j + 1) & ar(i, j + 2) = s Then k = k + 1
Next
ar(i, 1) = k
Next
[s14].Resize(i - 1) = ar
End Sub