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 11:45:33 -0700 (PDT) schrieb 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.

I hope I understood you correctly.
Try:

Sub CountConsZeros()
Dim rngC As Range
Dim i As Long

For Each rngC In Range("R26:AK26")
If rngC = 0 Then
Cells(20, rngC.Column) = 1
For i = 27 To 50
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

Hi Howard,

Am Wed, 24 Apr 2013 21:37:49 +0200 schrieb 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

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

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)

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

On Wednesday, April 24, 2013 1:40:28 PM UTC-7, Claus Busch wrote:
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)



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

Wonderful, perfect again!

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

Howard