Count consecutive cells (rows) with same value

[fb7894]

I'm looking to calculate the number of consecutive rows where a value exists. I want to calc the Consecutive Rows columns below using the data in Tank column. Not sure if I need VBA. I'd rather do with formula if possible.

Example Tank A repeats 3 consecutive times. Therefore Consecutive Rows = 3 from the first three rows.

Thank you!


Here is my data:

Tank	Consecutive Rows
A	3
A	3
A	3
B	2
B	2
A	6
A	6
A	6
A	6
A	6
A	6
B	5
B	5
B	5
B	5
B	5

[jolivanes]

Tanks A and B repeat in column A. Is that reality or just the way you copied it?
What I mean to ask is if the same name will come back again after a different name.
In the meantime you can try this.

Sub Count_Tanks()
    Dim lr As Long, c As Range
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    Cells(2, 2).Value = 1
    For Each c In Range("A3:A" & lr)
        If c.Value = c.Offset(-1).Value Then
            c.Offset(, 1).Value = c.Offset(-1, 1).Value + 1
        Else
            c.Offset(, 1).Value = 1
        End If
    Next c
End Sub

[jolivanes]

Looking again at your request, the previous code is not what you wanted.
This code should be closer to what you want I think.

Sub Count_Tanks_B()
    Dim lr As Long, c As Range, a As Long
    Application.ScreenUpdating = False
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    For Each c In Range("A2:A" & lr)
        If c.Value <> c.Offset(1).Value Then
            a = Cells(c.Row, 2).End(xlUp).Row
            Range(Cells(c.Row, 2), Cells(c.Row, 2).End(xlUp).Offset(1)).Value = c.Row - a
        Else
        End If
    Next c
    Application.ScreenUpdating = True
End Sub

[jolivanes]

@fb7894
Did it work?

[JulesG]

Hi there,

I stumble upon the same problem and fine tuned your code to this one:

Application.ScreenUpdating = False
lr = Worksheets(X).Cells(Rows.Count, 27).End(xlUp).Row
For Each c In Worksheets(X).Range("AA13:AA" & lr)
If c.Text <> c.Offset(1).Text Then

Worksheets(X).Range(Cells(c.Row, 30), Cells(c.Row, 30)).Value = d + 1
With Worksheets(X).Range(Cells(c.Row, 27), Cells(c.Row - d, 27))
.MergeCells = True
End With
d = 0
Else
d = d + 1
End If

Next c
Application.ScreenUpdating = True

I must add that I had to copy the whole code to the "module" part of the VBA project as this line of code was giving my trouble:
Worksheets(X).Range(Cells(c.Row, 30), Cells(c.Row, 30)).Value = d + 1

In the end it works.
Hope that helps!

Cheers

[jolivanes]

Good.
Next time please use code tags around your code.
Good luck