Count range macro

[charlie_580]

I have the following macro

Sub AddBlankRows()
'
Dim iRow As Integer, iCol As Integer
Dim oRng As Range

Set oRng = Range("a1")

iRow = oRng.Row
iCol = oRng.Column

Do
'
If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
Cells(iRow + 1, iCol).EntireRow.Insert shift:=xlDown
iRow = iRow + 2
Else
iRow = iRow + 1
End If
'
Loop While Not Cells(iRow, iCol).Text = ""
'
End Sub

This looks for the last cell containing the same number and inserts a blank row. What I need, is to then insert a count for the cells above, again only for cells containing the same number.

 

[Norie]

Try this.

Sub AddBlankRows()
'
Dim iRow As Integer, iCol As Integer
Dim oRng As Range

Set oRng = Range("a1")

    iRow = oRng.Row
    iCol = oRng.Column

    Do
        '
        If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
            Cells(iRow + 1, iCol).EntireRow.Insert shift:=xlDown
            Cells(iRow + 1, iCol).FormulaR1C1 = "=COUNTIF(R1C:R[-1]C, R[-1]C)"
            iRow = iRow + 2
        Else
            iRow = iRow + 1
        End If
    '
    Loop While Not Cells(iRow, iCol).Text = ""

End Sub

 

[charlie_580]

Try this.

Sub AddBlankRows()
'
Dim iRow As Integer, iCol As Integer
Dim oRng As Range

Set oRng = Range("a1")

    iRow = oRng.Row
    iCol = oRng.Column

    Do
        '
        If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
            Cells(iRow + 1, iCol).EntireRow.Insert shift:=xlDown
            Cells(iRow + 1, iCol).FormulaR1C1 = "=COUNTIF(R1C:R[-1]C, R[-1]C)"
            iRow = iRow + 2
        Else
            iRow = iRow + 1
        End If
    '
    Loop While Not Cells(iRow, iCol).Text = ""

End Sub

Perfect. Cheers