For-Next by a row Counting consecutive Zero in the column

  • Thread starter Thread starter Howard
  • Start date Start date
H

Howard

Starting with R26 over to AK26, count the number of consecutive zeros starting with row 26 and down until no more data OR a cell <> 0.

Then that total goes into cell 20 of the row being counted.
If first cell is not a zero then cell 20 = 0, go to next column.

Thanks.
Regards,
Howard


Option Explicit

Sub nestingLoops()

Dim iCell As Range
Dim cCell As Long

For Each iCell In ActiveSheet.Range("R26:AK26")

With iCell

If iCell <> 0 Then
cCell = 0
'then cell 20 of this column = cCell.Value (which is 0)
'move to S26 and do the same until AK26
ElseIf iCell = 0 Then
cCell = cCell + 1
'go to next cell down and if it = 0
'cCell = cCell + 1 (which is now 2)

'go to next cell down and next cell down until cell <> 0 _
'OR the end of the data in this column

'then cell 20 of this column = cCell.Value _
'(which is the total of consective cells that did = 0)

'then go to S26 and do the same until AK26
End If

End With

Next iCell

End Sub
 
Hi Howard,

Am Wed, 24 Apr 2013 21:37:49 +0200 schrieb Claus Busch:
I hope I understood you correctly.
Click to expand...

if the loop from 27 to 50 is not enough for you you can use the last
row. There are two times LRow in the code. Have a look which of them you
need:
Sub CountConsZeros()
Dim rngC As Range
Dim i As Long
Dim LRow As Long

'If count of rows is equal in every column
LRow = Cells(Rows.Count, "R").End(xlUp).Row
For Each rngC In Range("R26:AK26")
If rngC = 0 Then
Cells(20, rngC.Column) = 1
'If count or rows differs from column to column
' LRow = Cells(Rows.Count, rngC.Column).End(xlUp).Row
For i = 27 To LRow
If Cells(i, rngC.Column) = 0 Then
Cells(20, rngC.Column) = _
Cells(20, rngC.Column) + 1
Else
Exit For
End If
Next i
End If
Next rngC
End Sub


Regards
Claus Busch
 
I hope I understood you correctly.
if the loop from 27 to 50 is not enough for you you can use the last

row. There are two times LRow in the code. Have a look which of them you

need:

Sub CountConsZeros()

Dim rngC As Range

Dim i As Long

Dim LRow As Long



'If count of rows is equal in every column

LRow = Cells(Rows.Count, "R").End(xlUp).Row

For Each rngC In Range("R26:AK26")

If rngC = 0 Then

Cells(20, rngC.Column) = 1

'If count or rows differs from column to column

' LRow = Cells(Rows.Count, rngC.Column).End(xlUp).Row

For i = 27 To LRow

If Cells(i, rngC.Column) = 0 Then

Cells(20, rngC.Column) = _

Cells(20, rngC.Column) + 1

Else

Exit For

End If

Next i

End If

Next rngC

End Sub





Regards

Claus Busch

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2
Click to expand...

I used the ['If count or rows differs from column to column] and works fine with one small exception:

10
0
0
0
0
x

With a column like this, cell 20 should = 0 (because the first cell is not a zero the column is then dismissed)

It now returns "blank"

Howard
 
Hi Howard,

Am Wed, 24 Apr 2013 13:33:12 -0700 (PDT) schrieb Howard:
I used the ['If count or rows differs from column to column] and works fine with one small exception:

10
0
0
0
0
x

With a column like this, cell 20 should = 0 (because the first cell is not a zero the column is then dismissed)
Click to expand...

sorry, I forgot.
You have to insert a Else:

For Each rngC In Range("R26:AK26")
If rngC = 0 Then
Cells(20, rngC.Column) = 1
LRow = Cells(Rows.Count, rngC.Column).End(xlUp).Row
For i = 27 To LRow
If Cells(i, rngC.Column) = 0 Then
Cells(20, rngC.Column) = _
Cells(20, rngC.Column) + 1
Else
Exit For
End If
Next i
Else
Cells(20, rngC.Column) = 0
End If
Next rngC


Regards
Claus Busch
 
Hi Howard,



Am Wed, 24 Apr 2013 13:33:12 -0700 (PDT) schrieb Howard:


I used the ['If count or rows differs from column to column] and works fine with one small exception:
10
Click to expand...
0
Click to expand...
0
Click to expand...
0
Click to expand...
0
Click to expand...
x
Click to expand...

With a column like this, cell 20 should = 0 (because the first cell is not a zero the column is then dismissed)
Click to expand...



sorry, I forgot.

You have to insert a Else:



For Each rngC In Range("R26:AK26")

If rngC = 0 Then

Cells(20, rngC.Column) = 1

LRow = Cells(Rows.Count, rngC.Column).End(xlUp).Row

For i = 27 To LRow

If Cells(i, rngC.Column) = 0 Then

Cells(20, rngC.Column) = _

Cells(20, rngC.Column) + 1

Else

Exit For

End If

Next i

Else

Cells(20, rngC.Column) = 0

End If

Next rngC





Regards

Claus Busch

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2
Click to expand...

Wonderful, perfect again!

Thanks Claus, as always I sure appreciate you good work.

Howard
 
Back
Top