'this subroutine counts the no. of consecutive 1's appearing in a column range
Sub countONES()
Dim lastrow As Long ' denotes the last NON-EMPTY cell in the column range
Dim count As Long ' increments each time upon encountering a 1
Dim counter As Long ' increments each time upon encountering 15 consecutive 1's or more
Dim startcell As String ' used when extracting the column name in the messagebox
Dim pos1 As Integer ' position of the "$" sign in the cell address -> startcell
Dim pos2 As Integer ' position of the 2nd "$" sign in the cell address -> startcell
'intialise counter
counter = 0
counter = 0
'find the last NON-EMPTY cell in the column
lastrow = Range("A65536").End(xlUp).Row
'select the first cell in the column (in this case Column A - you can change this)
Range("A1").Select
startcell = ActiveCell.Address
pos1 = InStr(1, startcell, "$")
pos2 = InStrRev(startcell, "$", -1)
For icount = 1 To lastrow
If ActiveCell.Value = 1 Then
'increment count each time when you encounter a 1
count = count + 1
If count >= 15 Then
'increment counter each time when you encounter 15 consecutive 1's
counter = counter + 1
'reset count - why ? - need to start over again so as to keep track of the next 15 consecutive 1's
count = 0
End If
Else
'reset count - why ? - need to start over again so as to keep track of the next 15 consecutive 1's
count = 0
End If
'select the next cell
ActiveCell.Offset(1, 0).Select
Next icount
MsgBox "The no. of 15 consecutive 1's in column " & Mid(startcell, pos1 + 1, pos2 - pos1 - 1) & " = " & counter, vbInformation, "Consecutive 1's ?"
End Sub